Interrupt handlers DO want to use signal-thread-event.

Undo ba92c7c's changes to runtime/intrpt.scm.  Also, call %maybe-
toggle-thread-timer after calling %signal-thread-event in runtime/
gcnote and runtime/process.

diff --git a/src/runtime/gcnote.scm b/src/runtime/gcnote.scm
index 1b69510e9f634b72bd50c12d4624a2257a624a16..62c9b3cb7734186978ef584afa0cb6bbb5f5bbbf 100644 (file)
--- a/src/runtime/gcnote.scm
+++ b/src/runtime/gcnote.scm
@@ -108,34 +108,34 @@ USA.
     (and entry (weak-cdr entry))))
 
 (define (signal-gc-events)
-  (let ((statistic last-statistic))
-    (if (< (gc-statistic/heap-left statistic) 4096)
-       (begin
-         (for-each
-           (lambda (entry)
-             (let ((thread (weak-car entry))
-                   (event (weak-cdr entry)))
-               (if (and thread event)
-                   (signal-event thread abort-heap-low))))
-           gc-events)
-         (let ((console-thread
-                (thread-mutex-owner (port/thread-mutex console-i/o-port))))
-           (if (not (weak-assq console-thread gc-events))
-               (signal-event console-thread abort-heap-low))))
-       (for-each
-         (lambda (entry)
-           (let ((thread (weak-car entry))
-                 (event (weak-cdr entry)))
-             (if (and thread event)
-                 (signal-event thread (named-lambda (gc-event)
-                                        (event statistic))))))
-         gc-events))))
-
-(define (signal-event thread event)
-  (without-interrupts
-   (lambda ()
-     (if (not (eq? 'DEAD (thread-execution-state thread)))
-        (%signal-thread-event thread event)))))
+  (let ((statistic last-statistic)
+       (signaled? #f))
+
+    (define (signal-event thread event)
+      (if (and thread (not (eq? 'DEAD (thread-execution-state thread))))
+         (begin
+           (%signal-thread-event thread event)
+           (set! signaled? #t))))
+
+    (without-interrupts
+     (lambda ()
+       (if (< (gc-statistic/heap-left statistic) 4096)
+          (begin
+            (for-each
+              (lambda (entry)
+                (signal-event (weak-car entry) abort-heap-low))
+              gc-events)
+            (let ((thread (console-thread)))
+              (if (and thread (not (weak-assq thread gc-events)))
+                  (signal-event thread abort-heap-low))))
+          (for-each
+            (lambda (entry)
+              (let ((thread (weak-car entry))
+                    (event (weak-cdr entry)))
+                (signal-event thread (named-lambda (gc-event)
+                                       (event statistic)))))
+            gc-events))
+       (if signaled? (%maybe-toggle-thread-timer))))))
 
 (define (weak-assq obj alist)
   (let loop ((alist alist))

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

diff --git a/src/runtime/process.scm b/src/runtime/process.scm
index 655a9a4d25cafde5a1b40c07beaae7fd8685edb3..d7b3e3c474233c0942a190e5561282c0d97be1cb 100644 (file)
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -282,7 +282,10 @@ USA.
         (if (not (eq? status current))
             (begin
               (%signal-thread-event
-               thread (and event (lambda () (event current))))
+               thread (and event
+                           (named-lambda (immediate-subprocess-status-event)
+                             (event current))))
+              (%maybe-toggle-thread-timer)
               (set-subprocess-registration/status! registration current))))))
     registration))
 
@@ -321,7 +324,7 @@ USA.
 
 (define (%handle-subprocess-status-change)
   (if ((ucode-primitive process-status-sync-all 0))
-      (begin
+      (let ((signaled? #f))
        (for-each (lambda (weak)
                    (let ((subprocess (weak-car weak)))
                      (if subprocess
@@ -336,7 +339,10 @@ USA.
                  (let ((event (subprocess-registration/event registration)))
                    (%signal-thread-event
                     (subprocess-registration/thread registration)
-                    (and event (lambda () (event status))))
+                    (and event
+                         (named-lambda (subprocess-status-event)
+                           (event status))))
+                   (set! signaled? #t)
                    (set-subprocess-registration/status! registration
                                                         status)))))
          subprocess-registrations)
@@ -346,7 +352,8 @@ USA.
                                (subprocess-registration/status registration)))
                           (not (or (eq? status 'EXITED)
                                    (eq? status 'SIGNALLED)))))
-                      subprocess-registrations)))))
+                      subprocess-registrations))
+       (if signaled? (%maybe-toggle-thread-timer)))))
 
 (define-integrable subprocess-job-control-available?
   (ucode-primitive os-job-control? 0))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index 20ba5c364a3d7ce8460b1b8bc25af48a236c1c93..8848df1c297d19d58be0a27ed5ee5b9a648822ca 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -2037,6 +2037,7 @@ USA.
   (export (runtime thread)
          %deregister-gc-event)
   (import (runtime thread)
+         %maybe-toggle-thread-timer
          %signal-thread-event)
   (initialization (initialize-package!)))
 
@@ -2484,8 +2485,6 @@ USA.
          generate-suspend-file?)
   (export (runtime swank)
          keyboard-interrupt-vector)
-  (import (runtime thread)
-         %signal-thread-event)
   (initialization (initialize-package!)))
 
 (define-package (runtime lambda-abstraction)
@@ -3908,6 +3907,7 @@ USA.
          deregister-subprocess-events
          %handle-subprocess-status-change)
   (import (runtime thread)
+         %maybe-toggle-thread-timer
          %signal-thread-event
          subprocess-registrations
          subprocess-support-loaded?)