From f3d6b87bfce30b0ea217198cc64593e786dbf790 Mon Sep 17 00:00:00 2001 From: Chris Hanson Date: Fri, 24 Oct 1997 06:47:56 +0000 Subject: [PATCH] When killing a subprocess on NT, close our end of the channels talking to the subprocess. It turns out that some processes don't close properly until this is done. --- v7/src/runtime/process.scm | 52 +++++++++++++++++++++++--------------- 1 file changed, 31 insertions(+), 21 deletions(-) diff --git a/v7/src/runtime/process.scm b/v7/src/runtime/process.scm index 46f732aa3..14665d985 100644 --- a/v7/src/runtime/process.scm +++ b/v7/src/runtime/process.scm @@ -1,6 +1,6 @@ #| -*-Scheme-*- -$Id: process.scm,v 1.19 1997/10/22 05:15:41 cph Exp $ +$Id: process.scm,v 1.20 1997/10/24 06:47:56 cph Exp $ Copyright (c) 1989-97 Massachusetts Institute of Technology @@ -127,6 +127,27 @@ MIT in each case. |# (let ((port (subprocess-i/o-port process))) (and (output-port? port) port))) + +(define (%close-subprocess-i/o process) + ;; Assumes that interrupts are locked. + (cond ((subprocess-%i/o-port process) + => (lambda (port) + (set-subprocess-%i/o-port! process false) + (set-subprocess-input-channel! process false) + (set-subprocess-output-channel! process false) + (close-port port)))) + (cond ((subprocess-input-channel process) + => (lambda (input-channel) + (set-subprocess-input-channel! process false) + (channel-close input-channel)))) + (cond ((subprocess-output-channel process) + => (lambda (output-channel) + (set-subprocess-output-channel! process false) + (channel-close output-channel)))) + (cond ((subprocess-pty-master process) + => (lambda (pty-master) + (set-subprocess-pty-master! process false) + (channel-close pty-master))))) (define (make-subprocess filename arguments environment ctty stdin stdout stderr @@ -188,24 +209,7 @@ MIT in each case. |# ((ucode-primitive process-delete 1) (subprocess-index process)) (set! subprocesses (delq! process subprocesses)) (set-subprocess-index! process false) - (cond ((subprocess-%i/o-port process) - => (lambda (port) - (set-subprocess-%i/o-port! process false) - (set-subprocess-input-channel! process false) - (set-subprocess-output-channel! process false) - (close-port port)))) - (cond ((subprocess-input-channel process) - => (lambda (input-channel) - (set-subprocess-input-channel! process false) - (channel-close input-channel)))) - (cond ((subprocess-output-channel process) - => (lambda (output-channel) - (set-subprocess-output-channel! process false) - (channel-close output-channel)))) - (cond ((subprocess-pty-master process) - => (lambda (pty-master) - (set-subprocess-pty-master! process false) - (channel-close pty-master))))))))) + (%close-subprocess-i/o process)))))) (define (subprocess-status process) (convert-subprocess-status (%subprocess-status process))) @@ -286,7 +290,8 @@ MIT in each case. |# ((ucode-primitive process-signal 2) (subprocess-index process) signal)) (define (subprocess-kill process) - ((ucode-primitive process-kill 1) (subprocess-index process))) + ((ucode-primitive process-kill 1) (subprocess-index process)) + (maybe-close-subprocess-i/o process)) (define (subprocess-interrupt process) ((ucode-primitive process-interrupt 1) (subprocess-index process))) @@ -295,7 +300,12 @@ MIT in each case. |# ((ucode-primitive process-quit 1) (subprocess-index process))) (define (subprocess-hangup process) - ((ucode-primitive process-hangup 1) (subprocess-index process))) + ((ucode-primitive process-hangup 1) (subprocess-index process)) + (maybe-close-subprocess-i/o process)) + +(define (maybe-close-subprocess-i/o process) + (if (eq? 'NT microcode-id/operating-system) + (without-interrupts (lambda () (%close-subprocess-i/o process))))) (define (subprocess-stop process) ((ucode-primitive process-stop 1) (subprocess-index process))) -- 2.25.1