Process pending thread events when unblocking them.

Partly fixes bug where profiler never got a chance to run when the
program was doing most of its work in short routines that block and
unblock thread events, like opening and closing files.

Only partly, because it seems something else unblocks thread events
without processing them -- until we do another block/unblock cycle as
in channel-close.  Verified that very little time is actually spent
in channel-close; haven't yet tracked down who the culprit is.

(cherry picked from commit b0b11d54bc0d0cf639ca7205fc8e3396e4fd6807)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 943ca559243016ddd635565425f68c5144a6dc34..4977ea0d7047a9392420732faee338f581d21d8e 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -901,9 +901,7 @@ USA.
                        value))
                    'with-thread-events-blocked
                    block-events?)))
-             (let ((thread first-running-thread))
-               (if thread
-                   (set-thread/block-events?! thread block-events?)))
+             (%set-thread-event-block! block-events?)
              (set-interrupt-enables! interrupt-mask)
              value))
          (begin
@@ -921,10 +919,16 @@ USA.
 (define (set-thread-event-block! block?)
   (without-interrupts
    (lambda ()
-     (let ((thread first-running-thread))
-       (if thread
-          (set-thread/block-events?! thread block?)))
-     unspecific)))
+     (%set-thread-event-block! block?))))
+
+(define (%set-thread-event-block! block?)
+  (let ((thread first-running-thread))
+    (if thread
+       (begin
+         (if (not block?)
+             (handle-thread-events thread))
+         (set-thread/block-events?! thread block?))))
+  unspecific)
 \f
 (define (signal-thread-event thread event #!optional no-error?)
   (guarantee thread? thread 'signal-thread-event)