From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Sun, 22 Feb 2015 19:55:32 +0000 (-0700)
Subject: smp: Squash into 3b4bc23.  Lock signal-subprocess-status-change
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=3096faccc35aef3a72fc2549018bca86c50772f6;p=mit-scheme.git

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 b2ae8111d..f3f38f811 100644
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -261,18 +261,24 @@ USA.
 
 (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 252f7eb2f..5813c2481 100644
--- 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 6d180f689..219fe067c 100644
--- 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)