smp: Squash into 3b4bc23. Lock signal-subprocess-status-change

when called by handle-subprocess-status-change.  Use %handle-
subprocess-status-change internally, to avoid a second (dead)lock.

diff --git a/src/runtime/process.scm b/src/runtime/process.scm
index b2ae8111d817a2149cee32634c783009839ced4f..f3f38f8113f69b281d2d685a09f7ea7a70d3a178 100644 (file)
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -261,18 +261,24 @@ USA.
 \f
 (define last-global-tick '())
 
-(define (handle-subprocess-status-change)
+(define (handle-status-change signaler)
   (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))))
+         (signaler)
+         (set! last-global-tick latest-tick)))))
+
+(define (handle-subprocess-status-change)
+  (handle-status-change signal-subprocess-status-change)
   (if (eq? 'NT microcode-id/operating-system)
       (for-each (lambda (process)
                  (if (memq (subprocess-status process) '(EXITED SIGNALLED))
                      (close-subprocess-i/o process)))
                (subprocess-list))))
 
+(define (%handle-subprocess-status-change)
+  (handle-status-change %signal-subprocess-status-change))
+
 (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 252f7eb2f4a2f8d320c58cf98a8040c084a8aba0..5813c2481b013569763d2d117522ddb739c83a30 100644 (file)
--- a/src/runtime/runtime.pkg
+++ b/src/runtime/runtime.pkg
@@ -3855,8 +3855,9 @@ USA.
   (export (runtime socket)
          handle-subprocess-status-change)
   (export (runtime thread)
-         handle-subprocess-status-change)
+         %handle-subprocess-status-change)
   (import (runtime thread)
+         %signal-subprocess-status-change
          signal-subprocess-status-change)
   (initialization (initialize-package!)))
 

diff --git a/src/runtime/thread.scm b/src/runtime/thread.scm
index 6d180f6894ae03bab0f68846633e030e0d28ed1b..219fe067cb38f4eac18ff735e883e71fd7f1340b 100644 (file)
--- a/src/runtime/thread.scm
+++ b/src/runtime/thread.scm
@@ -710,10 +710,15 @@ USA.
                                  (vector-ref result 1)
                                  (vector-ref result 2)))
        ((eq? 'PROCESS-STATUS-CHANGE result)
-        (handle-subprocess-status-change))))
+        (%handle-subprocess-status-change))))
 
 (define (signal-subprocess-status-change)
   (%%trace ";"(%%id)" signal-subprocess-status-change\n")
+  (with-threads-locked %signal-subprocess-status-change))
+
+(define (%signal-subprocess-status-change)
+  (%%trace ";"(%%id)" %signal-subprocess-status-change\n")
+  (assert-locked '%signal-subprocess-status-change)
   (signal-io-thread-events 1 '#(PROCESS-STATUS-CHANGE) '#(READ)))
 
 (define (maybe-signal-io-thread-events)
@@ -730,7 +735,7 @@ USA.
 (define (maybe-signal-subprocess-status)
   (assert-locked 'maybe-signal-subprocess-status)
   (%%trace ";"(%%id)" maybe-signal-subprocess-status\n")
-  (handle-subprocess-status-change))
+  (%handle-subprocess-status-change))
 
 (define (block-on-io-descriptor descriptor mode)
   (let ((result 'INTERRUPT)