From 6df4f73e48be7d8261efc7ae462ce2be0b4a676d Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Fri, 29 Apr 2016 14:16:44 -0700 Subject: [PATCH] Handle GC events immediately, at end of after-gc interrupt. --- src/runtime/intrpt.scm | 3 ++- src/runtime/runtime.pkg | 2 ++ src/runtime/thread.scm | 10 ++++++++++ 3 files changed, 14 insertions(+), 1 deletion(-) diff --git a/src/runtime/intrpt.scm b/src/runtime/intrpt.scm index 5cceb67d9..c0ce99c94 100644 --- a/src/runtime/intrpt.scm +++ b/src/runtime/intrpt.scm @@ -128,7 +128,8 @@ USA. (begin (set! running? #t) (trigger-gc-daemons!) - (set! running? #f)))))) + (set! running? #f) + (handle-current-thread-events)))))) (define event:console-resize) (define (console-resize-handler interrupt-code interrupt-enables) diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg index 15380de2c..7c634e3a7 100644 --- a/src/runtime/runtime.pkg +++ b/src/runtime/runtime.pkg @@ -2480,6 +2480,8 @@ USA. generate-suspend-file?) (export (runtime swank) keyboard-interrupt-vector) + (import (runtime thread) + handle-current-thread-events) (initialization (initialize-package!))) (define-package (runtime lambda-abstraction) diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm index bd4eb666d..161774b70 100644 --- a/src/runtime/thread.scm +++ b/src/runtime/thread.scm @@ -972,6 +972,16 @@ USA. (deliver-timer-events (get-system-times)) (maybe-signal-io-thread-events)))) (%maybe-toggle-thread-timer)))) + +(define (handle-current-thread-events) + (without-interrupts + (lambda () + (let ((thread first-running-thread)) + (if thread + (if (not (thread/block-events? thread)) + (handle-thread-events thread)) + (outf-error + "\nhandle-current-thread-events: no current thread\n")))))) ;;;; Subprocess Events -- 2.25.1