From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 8 Jan 1998 05:59:11 +0000 (+0000)
Subject: Fix bug in Windows 95: when a subprocess exits, close its I/O ports.
X-Git-Tag: 20090517-FFI~4901
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=2f20c918337036dcfd7d8a1ac1cac2570e5dc2eb;p=mit-scheme.git

Fix bug in Windows 95: when a subprocess exits, close its I/O ports.
This is necessary because our code can get into a state where it is
trying to read from a subprocess pipe and needs to be told that the
other end of the pipe was closed.  This indication is supplied by
Windows NT, but does not appear to work properly under Windows 95.
---

diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index 75d17d652..b9335d56a 100644
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: io.scm,v 14.52 1998/01/08 05:58:22 cph Exp $
+$Id: io.scm,v 14.53 1998/01/08 05:58:35 cph Exp $
 
-Copyright (c) 1988-97 Massachusetts Institute of Technology
+Copyright (c) 1988-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
diff --git a/v7/src/runtime/process.scm b/v7/src/runtime/process.scm
index 14665d985..747188825 100644
--- a/v7/src/runtime/process.scm
+++ b/v7/src/runtime/process.scm
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: process.scm,v 1.20 1997/10/24 06:47:56 cph Exp $
+$Id: process.scm,v 1.21 1998/01/08 05:58:54 cph Exp $
 
-Copyright (c) 1989-97 Massachusetts Institute of Technology
+Copyright (c) 1989-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -128,6 +128,9 @@ MIT in each case. |#
     (and (output-port? port)
 	 port)))
 
+(define (close-subprocess-i/o process)
+  (without-interrupts (lambda () (%close-subprocess-i/o process))))
+
 (define (%close-subprocess-i/o process)
   ;; Assumes that interrupts are locked.
   (cond ((subprocess-%i/o-port process)
@@ -268,7 +271,7 @@ MIT in each case. |#
     ((2) 'EXITED)
     ((3) 'SIGNALLED)
     (else (error "Illegal process status:" status))))
-
+
 (define (subprocess-job-control-status process)
   (let ((n
 	 ((ucode-primitive process-job-control-status 1)
@@ -279,6 +282,13 @@ MIT in each case. |#
       ((2) 'NO-JOB-CONTROL)
       ((3) 'JOB-CONTROL)
       (else (error "Illegal process job-control status:" n)))))
+
+(define (handle-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)))
+		subprocesses)))
 
 (define-integrable subprocess-job-control-available?
   (ucode-primitive os-job-control? 0))
@@ -305,7 +315,7 @@ MIT in each case. |#
 
 (define (maybe-close-subprocess-i/o process)
   (if (eq? 'NT microcode-id/operating-system)
-      (without-interrupts (lambda () (%close-subprocess-i/o process)))))
+      (close-subprocess-i/o process)))
 
 (define (subprocess-stop process)
   ((ucode-primitive process-stop 1) (subprocess-index process)))
diff --git a/v7/src/runtime/runtime.pkg b/v7/src/runtime/runtime.pkg
index 8a6491224..cf37f0d7e 100644
--- a/v7/src/runtime/runtime.pkg
+++ b/v7/src/runtime/runtime.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.288 1997/11/01 07:36:14 cph Exp $
+$Id: runtime.pkg,v 14.289 1998/01/08 05:59:11 cph Exp $
 
-Copyright (c) 1988-97 Massachusetts Institute of Technology
+Copyright (c) 1988-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -2328,6 +2328,8 @@ MIT in each case. |#
 	  subprocess-stop
 	  subprocess-wait
 	  subprocess?)
+  (export (runtime primitive-io)
+	  handle-subprocess-status-change)
   (initialization (initialize-package!)))
 
 (define-package (runtime graphics)
diff --git a/v8/src/runtime/runtime.pkg b/v8/src/runtime/runtime.pkg
index 1c72e52a3..1efbce4a7 100644
--- a/v8/src/runtime/runtime.pkg
+++ b/v8/src/runtime/runtime.pkg
@@ -1,8 +1,8 @@
 #| -*-Scheme-*-
 
-$Id: runtime.pkg,v 14.294 1997/11/01 07:35:47 cph Exp $
+$Id: runtime.pkg,v 14.295 1998/01/08 05:59:01 cph Exp $
 
-Copyright (c) 1988-97 Massachusetts Institute of Technology
+Copyright (c) 1988-98 Massachusetts Institute of Technology
 
 This material was developed by the Scheme project at the Massachusetts
 Institute of Technology, Department of Electrical Engineering and
@@ -2332,6 +2332,8 @@ MIT in each case. |#
 	  subprocess-stop
 	  subprocess-wait
 	  subprocess?)
+  (export (runtime primitive-io)
+	  handle-subprocess-status-change)
   (initialization (initialize-package!)))
 
 (define-package (runtime graphics)