1.0.6.59: bogus metacircles due to interrupted applicable method comp.

[sbcl.git] / src / code / target-signal.lisp

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index a59e730..c555dd2 100644 (file)
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -11,22 +11,36 @@
 
 (in-package "SB!UNIX")
 
+(defmacro with-interrupt-bindings (&body body)
+  `(let
+      ;; KLUDGE: Whatever is on the PCL stacks before the interrupt
+      ;; handler runs doesn't really matter, since we're not on the
+      ;; same call stack, really -- and if we don't bind these (esp.
+      ;; the cache one) we can get a bogus metacircle if an interrupt
+      ;; handler calls a GF that was being computed when the interrupt
+      ;; hit.
+      ((sb!pcl::*cache-miss-values-stack* nil)
+       (sb!pcl::*dfun-miss-gfs-on-stack* nil))
+     ,@body))
+
 (defun invoke-interruption (function)
-  (without-interrupts
-    ;; Reset signal mask: the C-side handler has blocked all
-    ;; deferrable interrupts before arranging return to lisp. This is
-    ;; safe because we can't get a pending interrupt before we unblock
-    ;; signals.
-    ;;
-    ;; FIXME: Should we not reset the _entire_ mask, just restore it
-    ;; to the state before we got the interrupt?
-    (reset-signal-mask)
-    (allow-with-interrupts (funcall function))))
-
-(defmacro in-interruption ((&rest args) &body body)
+  (with-interrupt-bindings
+    (without-interrupts
+      ;; Reset signal mask: the C-side handler has blocked all
+      ;; deferrable interrupts before arranging return to lisp. This is
+      ;; safe because we can't get a pending interrupt before we unblock
+      ;; signals.
+      ;;
+      ;; FIXME: Should we not reset the _entire_ mask, but just
+      ;; restore it to the state before we got the interrupt?
+      (reset-signal-mask)
+      (allow-with-interrupts (funcall function)))))
+
+(defmacro in-interruption ((&key) &body body)
   #!+sb-doc
   "Convenience macro on top of INVOKE-INTERRUPTION."
-  `(invoke-interruption (lambda () ,@body) ,@args))
+  `(dx-flet ((interruption () ,@body))
+     (invoke-interruption #'interruption)))
 \f
 ;;;; system calls that deal with signals