From: Matt Birkholz <matt@birchwood-abbey.net>
Date: Fri, 29 Apr 2016 21:16:44 +0000 (-0700)
Subject: Handle GC events immediately, at end of after-gc interrupt.
X-Git-Tag: mit-scheme-pucked-9.2.12~261^2~49
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=6df4f73e48be7d8261efc7ae462ce2be0b4a676d;p=mit-scheme.git

Handle GC events immediately, at end of after-gc interrupt.
---

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