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 5df6f15a569533cab8d9829f1b46c591979bd77d..2468b79965963541609ebcef35d5b9dbd45d0f4c 100644 (file)
--- a/src/runtime/process.scm
+++ b/src/runtime/process.scm
@@ -82,7 +82,7 @@ USA.
   (1d-table/remove! (subprocess-properties process) key))
 \f
 (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)))))
 \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))))
 \f
 (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)))