1.0.5.56: conditionally re-enable interrupts interrupting current thread

 * New variable: *IN-INTERRUPTION* is true IFF we're being called inside
   *IN-INTERRUPTION* and there are no intervening WITHOUT-INTERRUPTS.

 * INTERRUPT-THREAD calls the interrupt function inside WITH-INTERRUPTS
   when interrupting the current thread IFF *IN-INTERRUPTION* is true.

 * Remove bogus FIXME by yours truly from INVOKE-INTERRUPTION and
   properly explain what is going on -- and add another FIXME in its
   place.

 This makes nested SIGINTs DTRT.

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 79889f3..2e6fb42 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -1945,7 +1945,9 @@ SB-KERNEL) have been undone, but probably more remain."
                "%PRIMITIVE"
                "%STANDARD-CHAR-P"
                "*FOREIGN-LOCK*"
-               "*INTERRUPTS-ENABLED*" "*INTERRUPT-PENDING*"
+               "*IN-INTERRUPTION*"
+               "*INTERRUPTS-ENABLED*"
+               "*INTERRUPT-PENDING*"
                "*LINKAGE-INFO*"
                "*LONG-SITE-NAME*" "*SHORT-SITE-NAME*"
                "*RUNTIME-DLHANDLE*"

diff --git a/src/code/early-impl.lisp b/src/code/early-impl.lisp
index ea42696..0e457ca 100644 (file)
--- a/src/code/early-impl.lisp
+++ b/src/code/early-impl.lisp
@@ -33,6 +33,7 @@
                   ;; pseudo-atomicity too, but they handle it without
                   ;; messing with special variables.)
                   #!+(or x86 x86-64) *pseudo-atomic-bits*
+                  *in-interruption*
                   *interrupts-enabled*
                   *interrupt-pending*
                   *free-interrupt-context-index*

diff --git a/src/code/signal.lisp b/src/code/signal.lisp
index 41be48f..cc21007 100644 (file)
--- a/src/code/signal.lisp
+++ b/src/code/signal.lisp
@@ -40,6 +40,14 @@
 (defvar *interrupts-enabled* t)
 (defvar *interrupt-pending* nil)
 
+;;; KLUDGE: This tells INTERRUPT-THREAD that it is being invoked as an
+;;; interruption, so that if the thread being interrupted is the
+;;; current thread it knows to enable interrupts. INVOKE-INTERRUPTION
+;;; binds it to T, and WITHOUT-INTERRUPTS binds it to NIL, so that if
+;;; interrupts are disable between INTERRUPT-THREAD and this we don't
+;;; accidentally re-enable them.
+(defvar *in-interruption* nil)
+
 (sb!xc:defmacro without-interrupts (&body body)
   #!+sb-doc
   "Execute BODY with all deferrable interrupts deferred. Deferrable interrupts
@@ -51,7 +59,8 @@ other threads."
     `(flet ((,name () ,@body))
        (if *interrupts-enabled*
            (unwind-protect
-                (let ((*interrupts-enabled* nil))
+                (let ((*interrupts-enabled* nil)
+                      (*in-interruption* nil))
                   (,name))
              ;; If we were interrupted in the protected section, then
              ;; the interrupts are still blocked and it remains so

diff --git a/src/code/target-signal.lisp b/src/code/target-signal.lisp
index e7e827b..aaebc76 100644 (file)
--- a/src/code/target-signal.lisp
+++ b/src/code/target-signal.lisp
@@ -13,23 +13,17 @@
 
 (defun invoke-interruption (function)
   (without-interrupts
-    ;; FIXME: This is wrong. Imagine the following sequence:
+    ;; 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.
     ;;
-    ;; 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...
+    ;; FIXME: Should we not reset the _entire_ mask, just restore it
+    ;; to the state before we got the interrupt?
     (reset-signal-mask)
-    (funcall function)))
+    ;; Tell INTERRUPT-THREAD it's ok to re-enable interrupts.
+    (let ((*in-interruption* t))
+      (funcall function))))
 
 (defmacro in-interruption ((&rest args) &body body)
   #!+sb-doc

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index 8185b81..6f6cd93 100644 (file)
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -733,13 +733,15 @@ return DEFAULT if given or else signal JOIN-THREAD-ERROR."
      (with-mutex ((thread-interruptions-lock ,thread))
        ,@body)))
 
-;; Called from the signal handler.
+;; Called from the signal handler in C.
 (defun run-interruption ()
   (in-interruption ()
     (loop
        (let ((interruption (with-interruptions-lock (*current-thread*)
                              (pop (thread-interruptions *current-thread*)))))
          (if interruption
+             ;; This is safe because it's the IN-INTERRUPTION that
+             ;; has disabled interrupts.
              (with-interrupts
                (funcall interruption))
              (return))))))
@@ -759,21 +761,29 @@ nature: if you interrupt a thread that was holding important locks
 then do something that turns out to need those locks, you probably
 won't like the effect."
   #!-sb-thread (declare (ignore thread))
-  ;; not quite perfect, because it does not take WITHOUT-INTERRUPTS
-  ;; into account
-  #!-sb-thread
-  (funcall function)
-  #!+sb-thread
-  (if (eq thread *current-thread*)
-      (funcall function)
-      (let ((os-thread (thread-os-thread thread)))
-        (cond ((not os-thread)
-               (error 'interrupt-thread-error :thread thread))
-              (t
-               (with-interruptions-lock (thread)
-                 (push function (thread-interruptions thread)))
-               (when (minusp (signal-interrupt-thread os-thread))
-                 (error 'interrupt-thread-error :thread thread)))))))
+  (flet ((interrupt-self ()
+           ;; *IN-INTERRUPTION* is true IFF we're being called as an
+           ;; interruption without an intervening WITHOUT-INTERRUPTS,
+           ;; in which case it is safe to enable interrupts. Otherwise
+           ;; interrupts are either already enabled, or there is an outer
+           ;; WITHOUT-INTERRUPTS we know nothing about, which makes it
+           ;; unsafe to enable interrupts.
+           (if *in-interruption*
+               (with-interrupts (funcall function))
+               (funcall function))))
+    #!-sb-thread
+    (interrupt-self)
+    #!+sb-thread
+    (if (eq thread *current-thread*)
+        (interrupt-self)
+        (let ((os-thread (thread-os-thread thread)))
+          (cond ((not os-thread)
+                 (error 'interrupt-thread-error :thread thread))
+                (t
+                 (with-interruptions-lock (thread)
+                   (push function (thread-interruptions thread)))
+                 (when (minusp (signal-interrupt-thread os-thread))
+                   (error 'interrupt-thread-error :thread thread))))))))
 
 (defun terminate-thread (thread)
   #!+sb-doc

diff --git a/version.lisp-expr b/version.lisp-expr
index b49a5d6..f39562f 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.5.55"
+"1.0.5.56"