From ae2cdf67ab0110f0573e8b34428fef0c60ec3b60 Mon Sep 17 00:00:00 2001 From: Chris Hanson 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