From 45eb8e0569effae43ec89625ad6fab552507ed6b Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Tue, 23 Jun 2015 11:01:26 -0700 Subject: [PATCH] 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. --- src/runtime/process.scm | 38 ++++++++++++++++---------------------- 1 file changed, 16 insertions(+), 22 deletions(-) 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))) -- 2.25.1