smp: Check for SIGCHLD in thread timer interrupt handler.

An idle thread might get a SIGCHLD, wake and run the thread timer
interrupt handler (since there is no subprocess-status-change
interrupt) and return to idle.  If it is not the io-waiter, it does
not call test-select-registry nor otherwise notice the subprocess
status change.

Funnel all status change notifications through handle-subprocess-
status-change.  It uses the last-global-tick variable to remember the
tick when threads blocking on status changes were last woken.

diff --git a/src/runtime/process.scm b/src/runtime/process.scm
index 5df6f15a569533cab8d9829f1b46c591979bd77d..b2ae8111d817a2149cee32634c783009839ced4f 100644 (file)
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -259,7 +259,14 @@ USA.
       ((3) 'JOB-CONTROL)
       (else (error "Illegal process job-control status:" n)))))
 \f
+(define last-global-tick '())
+
 (define (handle-subprocess-status-change)
+  (let ((latest-tick (subprocess-global-status-tick)))
+    (if (not (eq? latest-tick last-global-tick))
+       (begin
+         (signal-subprocess-status-change)
+         (set! last-global-tick latest-tick))))
   (if (eq? 'NT microcode-id/operating-system)
       (for-each (lambda (process)
                  (if (memq (subprocess-status process) '(EXITED SIGNALLED))

diff --git a/src/runtime/runtime.pkg b/src/runtime/runtime.pkg
index c18b6067caced0eee7f206e3137fdc20ed0e6d73..4ecd6737a9fe9389cdbdbfb27792d36fdc391606 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3847,6 +3847,10 @@ USA.
          handle-subprocess-status-change)
   (export (runtime socket)
          handle-subprocess-status-change)
+  (export (runtime thread)
+         handle-subprocess-status-change)
+  (import (runtime thread)
+         signal-subprocess-status-change)
   (initialization (initialize-package!)))
 
 (define-package (runtime synchronous-subprocess)

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index aec8de6a0dede516037cb93e1338a5c82b04fd19..cdc984b1cc0bba63d61c269f3fee35f4ec3c4a6e 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -418,6 +418,7 @@ USA.
     (set! next-scheduled-timeout #f)
     (deliver-timer-events)
     (maybe-signal-io-thread-events)
+    (maybe-signal-subprocess-status)
     (cond ((and (not first-runnable-thread) (not old))
           (%maybe-toggle-thread-timer)
           (%%trace ";"id" thread-timer: continuing with timer set for "
@@ -654,18 +655,25 @@ USA.
                                  (vector-ref result 1)
                                  (vector-ref result 2)))
        ((eq? 'PROCESS-STATUS-CHANGE result)
-        (signal-io-thread-events 1
-                                 '#(PROCESS-STATUS-CHANGE)
-                                 '#(READ)))))
+        (handle-subprocess-status-change))))
+
+(define (signal-subprocess-status-change)
+  (%%trace ";"(%%id)" signal-subprocess-status-change\n")
+  (signal-io-thread-events 1 '#(PROCESS-STATUS-CHANGE) '#(READ)))
 
 (define (maybe-signal-io-thread-events)
-  (assert-locked 'maybe-signal-io-thread-events)
   (%%trace ";"(%%id)" maybe-signal-io-thread-events: testing\n")
+  (assert-locked 'maybe-signal-io-thread-events)
   (let ((result (test-select-registry io-registry #f)))
     (signal-select-result result)
     (%%trace ";"(%%id)" maybe-signal-io-thread-events => "
             (if (vector? result) (vector-ref result 0) result)"\n")))
 
+(define (maybe-signal-subprocess-status)
+  (assert-locked 'maybe-signal-subprocess-status)
+  (%%trace ";"(%%id)" maybe-signal-subprocess-status\n")
+  (handle-subprocess-status-change))
+
 (define (block-on-io-descriptor descriptor mode)
   (let ((result 'INTERRUPT)
        (thread (current-thread)))