X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-signal.lisp;h=c555dd2f57b83034c8ecaf0932b114d321d9e3eb;hb=b1cd84e0503ff29d72a860ea1709c87f721412ed;hp=7125c737c9715814dcc22d914e254f007a398532;hpb=a7409fa0a69f733ea2460a1aeddbe04b5c4c0888;p=sbcl.git

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index 7125c73..c555dd2 100644
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -11,30 +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
-    ;; FIXME: This is wrong. Imagine the following sequence:
-    ;;
-    ;; 1. an asynch interrupt arrives after entry to
-    ;;    WITHOUT-INTERRUPTS but before RESET-SIGNAL-MASK: pending
-    ;;    machinery blocks all signals and marks the signal as
-    ;;    pending.
-    ;;
-    ;; 2. RESET-SIGNAL-MASK is called, and all signals are unblocked.
-    ;;
-    ;; 3. Another signal arrives while we already have one pending.
-    ;;    Oops -- we lose().
-    ;;
-    ;; Not sure what the right thing is, but definitely not
-    ;; RESET-SIGNAL-MASK. Removing it breaks signals.impure.lisp
-    ;; right now, though, and this is a rare race, so...
-    (reset-signal-mask)
-    (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)))
 
 ;;;; system calls that deal with signals
 
@@ -184,31 +190,3 @@
 ;;;   Magically converted by the compiler into a break instruction.
 (defun receive-pending-interrupt ()
   (receive-pending-interrupt))
-
-;;; stale code which I'm insufficiently motivated to test -- WHN 19990714
-#|
-;;;; WITH-ENABLED-INTERRUPTS
-
-(defmacro with-enabled-interrupts (interrupt-list &body body)
-  #!+sb-doc
-  "With-enabled-interrupts ({(interrupt function)}*) {form}*
-   Establish function as a handler for the Unix signal interrupt which
-   should be a number between 1 and 31 inclusive."
-  (let ((il (gensym))
-        (it (gensym)))
-    `(let ((,il NIL))
-       (unwind-protect
-           (progn
-             ,@(do* ((item interrupt-list (cdr item))
-                     (intr (caar item) (caar item))
-                     (ifcn (cadar item) (cadar item))
-                     (forms NIL))
-                    ((null item) (nreverse forms))
-                 (when (symbolp intr)
-                   (setq intr (symbol-value intr)))
-                 (push `(push `(,,intr ,(enable-interrupt ,intr ,ifcn)) ,il)
-                       forms))
-             ,@body)
-         (dolist (,it (nreverse ,il))
-           (enable-interrupt (car ,it) (cadr ,it)))))))
-|#