From ae2cdf67ab0110f0573e8b34428fef0c60ec3b60 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Thu, 8 Jan 1998 05:58:22 +0000
Subject: [PATCH] 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.
---
v7/src/runtime/io.scm | 29 +++++++++++++++++------------
1 file changed, 17 insertions(+), 12 deletions(-)
diff --git a/v7/src/runtime/io.scm b/v7/src/runtime/io.scm
index fda662aa3..75d17d652 100644
--- a/v7/src/runtime/io.scm
+++ b/v7/src/runtime/io.scm
@@ -1,6 +1,6 @@
#| -*-Scheme-*-
-$Id: io.scm,v 14.51 1997/11/01 19:12:16 cph Exp $
+$Id: io.scm,v 14.52 1998/01/08 05:58:22 cph Exp $
Copyright (c) 1988-97 Massachusetts Institute of Technology
@@ -245,20 +245,25 @@ MIT in each case. |#
(let ((do-read
(lambda ()
((ucode-primitive channel-read 4) (channel-descriptor channel)
- buffer start end)))
- (do-test
- (lambda ()
- (eq? 'INPUT-AVAILABLE (test-for-input-on-channel channel)))))
- (declare (integrate-operator do-read do-test))
+ buffer start end))))
+ (declare (integrate-operator do-read))
(if (and have-select? (not (channel-type=file? channel)))
(let ((block-events? (block-thread-events)))
(let ((result
- (if (channel-blocking? channel)
- (begin
- (do () ((do-test)))
- (do-read))
- (and (do-test)
- (do-read)))))
+ (let ((do-test
+ (lambda (k)
+ (let ((result (test-for-input-on-channel channel)))
+ (case result
+ ((INPUT-AVAILABLE)
+ (do-read))
+ ((PROCESS-STATUS-CHANGE)
+ (handle-subprocess-status-change)
+ (if (channel-closed? channel) 0 (k)))
+ (else
+ (k)))))))
+ (if (channel-blocking? channel)
+ (let loop () (do-test loop))
+ (do-test (lambda () #f))))))
(if (not block-events?)
(unblock-thread-events))
result))
--
2.25.1