From 170d1d9acd237f4e026227e9aa8b767322b05410 Mon Sep 17 00:00:00 2001 From: Taylor R Campbell Date: Wed, 29 May 2019 04:10:57 +0000 Subject: [PATCH] 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) --- src/runtime/thread.scm | 18 +++++++++++------- 1 file changed, 11 insertions(+), 7 deletions(-) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index 943ca5592..4977ea0d7 100644 --- 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) (define (signal-thread-event thread event #!optional no-error?) (guarantee thread? thread 'signal-thread-event) -- 2.25.1