Revert previous change to close I/O ports of subprocesses when they
authorTaylor R. Campbell <net/mumble/campbell>
Sat, 16 Aug 2008 17:57:11 +0000 (17:57 +0000)
committerTaylor R. Campbell <net/mumble/campbell>
Sat, 16 Aug 2008 17:57:11 +0000 (17:57 +0000)
exit.

v7/src/runtime/process.scm

index 3bcb38b4db55dd650655b10b6f0b6231b7990fa8..436aa206832f6ef90b679c9abe0be580ef1e3d6a 100644 (file)
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: process.scm,v 1.36 2008/02/11 07:23:21 cph Exp $
+$Id: process.scm,v 1.37 2008/08/16 17:57:11 riastradh Exp $
 
 Copyright (C) 1986, 1987, 1988, 1989, 1990, 1991, 1992, 1993, 1994,
     1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
@@ -104,15 +104,12 @@ USA.
     (and (output-port? port)
         port)))
 
-(define (close-subprocess-i/o process #!optional close-port-too?)
-  (without-interrupts
-   (lambda ()
-     (%close-subprocess-i/o process close-port-too?))))
+(define (close-subprocess-i/o process)
+  (without-interrupts (lambda () (%close-subprocess-i/o process))))
 
-(define (%close-subprocess-i/o process close-port-too?)
+(define (%close-subprocess-i/o process)
   ;; Assumes that interrupts are locked.
-  (cond ((and close-port-too?
-             (subprocess-%i/o-port process))
+  (cond ((subprocess-%i/o-port process)
         => (lambda (port)
              (set-subprocess-%i/o-port! process #f)
              (set-subprocess-input-channel! process #f)
@@ -192,7 +189,7 @@ USA.
      (if (subprocess-index process)
         (begin
           (remove-from-gc-finalizer! subprocess-finalizer process)
-          (%close-subprocess-i/o process #t))))))
+          (%close-subprocess-i/o process))))))
 \f
 (define (subprocess-status process)
   (convert-subprocess-status (%subprocess-status process)))
@@ -264,10 +261,11 @@ USA.
       (else (error "Illegal process job-control status:" n)))))
 \f
 (define (handle-subprocess-status-change)
-  (for-each (lambda (process)
-             (if (memq (subprocess-status process) '(EXITED SIGNALLED))
-                 (close-subprocess-i/o process #f)))
-           (subprocess-list)))
+  (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-integrable subprocess-job-control-available?
   (ucode-primitive os-job-control? 0))