From c9b54c2d778acb6c85e6bae47928668811d0e462 Mon Sep 17 00:00:00 2001
From: Chris Hanson <org/chris-hanson/cph>
Date: Mon, 29 Apr 1991 10:51:41 +0000
Subject: [PATCH] Provide unwind-protect to delete a synchronous process if the
 process is aborted.

---
 v7/src/edwin/process.scm | 48 +++++++++++++++++++++++++---------------
 1 file changed, 30 insertions(+), 18 deletions(-)

diff --git a/v7/src/edwin/process.scm b/v7/src/edwin/process.scm
index c84d09e44..950c9cfc2 100644
--- a/v7/src/edwin/process.scm
+++ b/v7/src/edwin/process.scm
@@ -1,6 +1,6 @@
 ;;; -*-Scheme-*-
 ;;;
-;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.5 1991/04/29 10:19:30 cph Exp $
+;;;	$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/edwin/process.scm,v 1.6 1991/04/29 10:51:41 cph Exp $
 ;;;
 ;;;	Copyright (c) 1991 Massachusetts Institute of Technology
 ;;;
@@ -460,23 +460,35 @@ after the listing is made.)"
   (run-synchronous-process input-region output-mark "/bin/sh" "-c" command))
 
 (define (run-synchronous-process input-region output-mark program . arguments)
-  (let ((process
-	 (start-pipe-subprocess program
-				(list->vector
-				 (cons (os/filename-non-directory program)
-				       arguments))
-				false)))
-    (call-with-output-copier process output-mark
-      (lambda (copy-output)
-	(call-with-input-copier process input-region
-	  (lambda (copy-input)
-	    (let loop ()
-	      (copy-input)
-	      (copy-output)
-	      (let ((status (subprocess-status process)))
-		(if (eq? status 'RUNNING)
-		    (loop)
-		    status)))))))))
+  (let ((process false))
+    (dynamic-wind
+     (lambda ()
+       (if (not process)
+	   (set! process
+		 (start-pipe-subprocess
+		  program
+		  (list->vector
+		   (cons (os/filename-non-directory program) arguments))
+		  false)))
+       unspecific)
+     (lambda ()
+       (call-with-output-copier process output-mark
+	 (lambda (copy-output)
+	   (call-with-input-copier process input-region
+	     (lambda (copy-input)
+	       (let loop ()
+		 (copy-input)
+		 (copy-output)
+		 (let ((status (subprocess-status process)))
+		   (if (eq? status 'RUNNING)
+		       (loop)
+		       status))))))))
+     (lambda ()
+       (if (and process (not (eq? process 'DELETED)))
+	   (begin
+	     (subprocess-delete process)
+	     (set! process 'DELETED)))
+       unspecific))))
 
 (define (call-with-output-copier process output-mark receiver)
   (let ((output-mark (and output-mark (mark-left-inserting output-mark))))
-- 
2.25.1