GC daemons may run when there is no current thread(!).

Thus they cannot use signal-thread-event which, if there is no current
thread, will not return.  (Why DOES signal-thread-event call
run-thread?)

diff --git a/src/runtime/gcnote.scm b/src/runtime/gcnote.scm
index 20815e19d6c3babb33f88dd61f4fced581d3ae9d..949d72cc2c6e4324208234105b79fe942e63c891 100644 (file)
--- a/src/runtime/gcnote.scm
+++ b/src/runtime/gcnote.scm
@@ -114,12 +114,14 @@ USA.
        (let ((thread (weak-car entry))
              (event (weak-cdr entry)))
          (if (and thread event)
-             (signal-thread-event
-                 thread
-               (named-lambda (gc-event)
-                 (abort-if-heap-low (gc-statistic/heap-left statistic))
-                 (event statistic))
-               #t))))
+             (without-interrupts
+              (lambda ()
+                (if (not (eq? 'DEAD (thread-execution-state thread)))
+                    (%signal-thread-event
+                        thread
+                      (named-lambda (gc-event)
+                        (abort-if-heap-low (gc-statistic/heap-left statistic))
+                        (event statistic)))))))))
       gc-events)))
 
 (define (weak-assq obj alist)

diff --git a/src/runtime/intrpt.scm b/src/runtime/intrpt.scm
index 5cceb67d9dcac21126713c0e2a22674285528aea..011bf79714970b3028683082adff068fe31ea72a 100644 (file)
--- a/src/runtime/intrpt.scm
+++ b/src/runtime/intrpt.scm
@@ -136,9 +136,11 @@ USA.
   (clear-interrupts! interrupt-bit/global-3)
   (cond ((console-thread)
          => (lambda (thread)
-              (signal-thread-event thread
-                (lambda ()
-                  (event-distributor/invoke! event:console-resize)))))))
+             (without-interrupts
+              (lambda ()
+                (%signal-thread-event thread
+                  (lambda ()
+                    (event-distributor/invoke! event:console-resize)))))))))
 
 (define ((illegal-interrupt-handler interrupt-bit)
         interrupt-code interrupt-enables)
@@ -191,7 +193,7 @@ USA.
 (define (signal-interrupt hook/interrupt hook/clean-input char interrupt)
   (let ((thread (thread-mutex-owner (port/thread-mutex console-i/o-port))))
     (if thread
-       (signal-thread-event thread
+       (%signal-thread-event thread
          (lambda ()
            (if hook/interrupt
                (hook/interrupt))
@@ -244,7 +246,7 @@ USA.
        (vector-set! system-interrupt-vector character-slot
                     external-interrupt-handler)
        (vector-set! interrupt-mask-vector character-slot
-                    interrupt-mask/timer-ok)
+                    interrupt-mask/gc-ok)
 
        (vector-set! system-interrupt-vector after-gc-slot
                     after-gc-interrupt-handler)

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 95963c599e203967b1d2e1c524fc551ebf845632..e381d1afd894c9c5676fd9748da603fc30f6da06 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2036,6 +2036,8 @@ USA.
          with-gc-notification!)
   (export (runtime thread)
          %deregister-gc-event)
+  (import (runtime thread)
+         %signal-thread-event)
   (initialization (initialize-package!)))
 
 (define-package (runtime gc-statistics)
@@ -2482,6 +2484,8 @@ USA.
          generate-suspend-file?)
   (export (runtime swank)
          keyboard-interrupt-vector)
+  (import (runtime thread)
+         %signal-thread-event)
   (initialization (initialize-package!)))
 
 (define-package (runtime lambda-abstraction)