From: Matt Birkholz <puck@birchwood-abbey.net>
Date: Tue, 23 Jun 2015 18:01:26 +0000 (-0700)
Subject: Remove without-interrupts from runtime/process.scm.
X-Git-Tag: mit-scheme-pucked-9.2.12~376^2~30
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=45eb8e0569effae43ec89625ad6fab552507ed6b;p=mit-scheme.git

Remove without-interrupts from runtime/process.scm.

Serial access to a subprocess is the responsibility of the user.  Thus
subprocess-i/o-port and close-subprocess-i/o do not need without-
interrupts to implement it.

Closing a port twice should not signal an error, so subprocess-delete
and close-subprocess-i/o do not need even without-interruption.
However they should close the port before clearing the subprocess
slot, else an abort could drop the port and it's channels may not be
closed for an arbitrarily long time.

Status sync could miss changes and subprocess-i/o-port and
make-subprocess could drop a subprocess or port if aborted mid-stride.
They now use without-interruption.
---

diff --git a/src/runtime/process.scm b/src/runtime/process.scm
index 5df6f15a5..2468b7996 100644
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -82,7 +82,7 @@ USA.
   (1d-table/remove! (subprocess-properties process) key))
 
 (define (subprocess-i/o-port process)
-  (without-interrupts
+  (without-interruption
    (lambda ()
      (or (subprocess-%i/o-port process)
 	 (let ((port
@@ -104,28 +104,24 @@ USA.
 	 port)))
 
 (define (close-subprocess-i/o process)
-  (without-interrupts (lambda () (%close-subprocess-i/o process))))
-
-(define (%close-subprocess-i/o process)
-  ;; Assumes that interrupts are locked.
   (cond ((subprocess-%i/o-port process)
 	 => (lambda (port)
+	      (close-port port)
 	      (set-subprocess-%i/o-port! process #f)
 	      (set-subprocess-input-channel! process #f)
-	      (set-subprocess-output-channel! process #f)
-	      (close-port port))))
+	      (set-subprocess-output-channel! process #f))))
   (cond ((subprocess-input-channel process)
 	 => (lambda (input-channel)
-	      (set-subprocess-input-channel! process #f)
-	      (channel-close input-channel))))
+	      (channel-close input-channel)
+	      (set-subprocess-input-channel! process #f))))
   (cond ((subprocess-output-channel process)
 	 => (lambda (output-channel)
-	      (set-subprocess-output-channel! process #f)
-	      (channel-close output-channel))))
+	      (channel-close output-channel)
+	      (set-subprocess-output-channel! process #f))))
   (cond ((subprocess-pty-master process)
 	 => (lambda (pty-master)
-	      (set-subprocess-pty-master! process #f)
-	      (channel-close pty-master)))))
+	      (channel-close pty-master)
+	      (set-subprocess-pty-master! process #f)))))
 
 (define (make-subprocess filename arguments environment
 			 ctty stdin stdout stderr
@@ -159,7 +155,7 @@ USA.
 			 (and (cdr environment)
 			      (->namestring (cdr environment))))
 		   (set! environment (car environment))))
-	     (without-interrupts
+	     (without-interruption
 	      (lambda ()
 		(let ((index
 		       (os/make-subprocess filename arguments environment
@@ -183,12 +179,10 @@ USA.
     process))
 
 (define (subprocess-delete process)
-  (without-interrupts
-   (lambda ()
-     (if (subprocess-index process)
-	 (begin
-	   (remove-from-gc-finalizer! subprocess-finalizer process)
-	   (%close-subprocess-i/o process))))))
+  (if (subprocess-index process)
+      (begin
+	(close-subprocess-i/o process)
+	(remove-from-gc-finalizer! subprocess-finalizer process))))
 
 (define (subprocess-status process)
   (convert-subprocess-status (%subprocess-status process)))
@@ -211,7 +205,7 @@ USA.
 	  (convert-subprocess-status status)))))
 
 (define (%subprocess-status process)
-  (without-interrupts
+  (without-interruption
    (lambda ()
      (let ((index (subprocess-index process)))
        (if (and index ((ucode-primitive process-status-sync 1) index))
@@ -232,7 +226,7 @@ USA.
 	tick)))
 
 (define (subprocess-global-status-tick)
-  (without-interrupts
+  (without-interruption
    (lambda ()
      (if ((ucode-primitive process-status-sync-all 0))
 	 (let ((tick (cons #f #f)))