Handle GC events immediately, at end of after-gc interrupt.
authorMatt Birkholz <matt@birchwood-abbey.net>
Fri, 29 Apr 2016 21:16:44 +0000 (14:16 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Fri, 29 Apr 2016 21:16:44 +0000 (14:16 -0700)
src/runtime/intrpt.scm
src/runtime/runtime.pkg
src/runtime/thread.scm

index 5cceb67d9dcac21126713c0e2a22674285528aea..c0ce99c944e87032b6cfea127228d9dc5cc409fd 100644 (file)
@@ -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)
index 15380de2c7ae8a9f65308ca36500fa1c22b38d05..7c634e3a7c8dae12405b81a238cd9ab8e1ca4dcd 100644 (file)
@@ -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)
index bd4eb666d7e7e3fb1583f983d407e9abfbca8d10..161774b70b7c6e2e79b0235c12d034a1be14eb95 100644 (file)
@@ -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"))))))
 \f
 ;;;; Subprocess Events