X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=8c0f4868c5ddc85e41824db3548330a1fd114d44;hb=5d5894082c39ca44da75d38859d669c7b2108f6a;hp=c555dd2f57b83034c8ecaf0932b114d321d9e3eb;hpb=f3a7c6b54880895d1598b1844d7e6eba98af9e53;p=sbcl.git

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index c555dd2..8c0f486 100644
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -12,20 +12,26 @@
 (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))
+  (with-unique-names (empty)
+    `(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)
+          ;; Unless we do this, ADJUST-ARRAY and SORT would need to
+          ;; disable interrupts.
+          (,empty (vector))
+          (sb!impl::*zap-array-data-temp* ,empty)
+          (sb!impl::*merge-sort-temp-vector* ,empty))
+       ,@body)))
 
 (defun invoke-interruption (function)
-  (with-interrupt-bindings
-    (without-interrupts
+  (without-interrupts
+    (with-interrupt-bindings
       ;; 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
@@ -34,7 +40,8 @@
       ;; 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)))))
+      (let ((sb!debug:*stack-top-hint* (nth-value 1 (sb!kernel:find-interrupted-name-and-frame))))
+        (allow-with-interrupts (funcall function))))))
 
 (defmacro in-interruption ((&key) &body body)
   #!+sb-doc
@@ -85,6 +92,7 @@
   (declare (type (or function fixnum (member :default :ignore)) handler))
   (/show0 "enable-interrupt")
   (flet ((run-handler (&rest args)
+           (declare (truly-dynamic-extent args))
            (in-interruption ()
              (apply handler args))))
     (without-gcing