X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Ftarget-thread.lisp;fp=src%2Fcode%2Ftarget-thread.lisp;h=bf9b2a65c302574a407072bc1398a760fe69294f;hb=137710655b4fcb5567ea311d2cdc40f0d34619a4;hp=bd0d0fb2d256340e6e3a3367bfba6cdb17220de5;hpb=8f44447fc2229458a91e6ebaa2449758670de07a;p=sbcl.git

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index bd0d0fb..bf9b2a6 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -1526,12 +1526,28 @@ subject to change."
 #!+sb-thruption
 (defun run-interruption ()
   (in-interruption () ;the non-thruption code does this in the signal handler
-    (loop
-       (let ((interruption (with-interruptions-lock (*current-thread*)
-                             (pop (thread-interruptions *current-thread*)))))
-         (unless interruption
-           (return))
-         (funcall interruption)))))
+    (let ((interruption (with-interruptions-lock (*current-thread*)
+                          (pop (thread-interruptions *current-thread*)))))
+      (when interruption
+        (funcall interruption)
+        ;; I tried implementing this function as an explicit LOOP, because
+        ;; if we are currently processing the thruption queue, why not do
+        ;; all of them in one go instead of one-by-one?
+        ;;
+        ;; I still think LOOPing would be basically the right thing
+        ;; here.  But suppose some interruption unblocked deferrables.
+        ;; Will the next one be happy with that?  The answer is "no", at
+        ;; least in the sense that there are tests which check that
+        ;; deferrables are blocked at the beginning of a thruption, and
+        ;; races that make those tests fail.  Whether the tests are
+        ;; misguided or not, it seems easier/cleaner to loop implicitly
+        ;; -- and it's also what AK had implemented in the first place.
+        ;;
+        ;; The implicit loop is achieved by returning to C, but having C
+        ;; call back to us immediately.  The runtime will reset the sigmask
+        ;; in the mean time.
+        ;; -- DFL
+        (setf *thruption-pending* t)))))
 
 (defun interrupt-thread (thread function)
   #!+sb-doc