a bit of a misnomer.
process.scm:85: (without-interrupts
+ Caller: subprocess-i/o-port
process.scm:107: (without-interrupts (lambda () (%close-subprocess-i/o process))))
+ Caller: close-subprocess-i/o
process.scm:162: (without-interrupts
+ Caller: make-subprocess
process.scm:186: (without-interrupts
+ Caller: subprocess-delete
process.scm:214: (without-interrupts
+ Caller: %subprocess-status
process.scm:235: (without-interrupts
+ Caller: subprocess-global-status-tick
+ handle-status-change
+ handle-subprocess-status-change
+ %handle-subprocess-status-change
+ test-select-descriptor
+ test-select-registry
+ anyone -- exported to ()!
+
+ Subprocess-i/o-port and close-subprocess-i/o may be trying to
+ avoid other threads (who might try to cons or close the %i/o-
+ port too), but e.g. Edwin already ensures single-threaded use
+ of its subprocesses. I presumed all subprocess owners can
+ ensure single-threaded use, so I punted the without-interrupts
+ in both and moved calls to close-port before clearing the
+ slots. A port can safely be closed multiple times.
+
+ These procedures may also be trying to avoid inopportune
+ aborts. An abort during subprocess-i/o-port may drop a port,
+ if rarely, but a subsequent attempt should still be possible,
+ opening a second i/o channel and eventually closing the first
+ without using it. An abort during close-subprocess-i/o is OK;
+ its constituents, channel-close and port-close, are OK with
+ aborts and multiple closes. Channel-close is atomic. Port-
+ close can abort after its call to channel-close; the channel
+ will still yield EOFs until closed again without error.
+
+ Make-subprocess is just avoiding an abort that would drop a
+ new subprocess. Subprocess-finalizer serialization is enough.
+ Changed it to use without-interruption.
+
+ Subprocess-delete may be trying to avoid deleting a delete
+ subprocess, but I presumed single-threaded use. It may also
+ be avoiding aborts after subprocess i/o is closed and before
+ the subprocess is killed, but this is not unsafe. Punted the
+ without-interrupts but kept the check for a previously deleted
+ (in the single-threaded sense) process. Subprocess-delete can
+ still be applied to a subprocess multiple times without error
+ (barring concurrent deletes). Again moved abort-savy close-
+ subprocess-i/o before the kill.
+
+ %Subprocess-status must avoid an abort after updating %status
+ and before exit-reason. It also attempts to avoid passing the
+ index #f to the subprocess primitives, but the presumption of
+ single-threaded access guarantees this, and if the guarantee
+ is broken the primitive simply signals an error. Changed
+ without-interrupts into without-interruption.
+
+ Subprocess-global-status-tick uses the process-status-sync-all
+ primitive, which is safe for concurrent use. It will only
+ tell one of two concurrent threads to update the global-
+ status-tick variable. How soon other threads observe the new
+ tick actually makes little difference.
queue.scm:73: (without-interrupts (lambda () (queued?/unsafe queue item))))
queue.scm:76: (without-interrupts (lambda () (enqueue!/unsafe queue object))))
(1d-table/remove! (subprocess-properties process) key))
\f
(define (subprocess-i/o-port process)
- (without-interrupts
- (lambda ()
- (or (subprocess-%i/o-port process)
- (let ((port
- (let ((input-channel (subprocess-input-channel process))
- (output-channel (subprocess-output-channel process)))
- (and (or input-channel output-channel)
- (make-generic-i/o-port input-channel output-channel)))))
- (set-subprocess-%i/o-port! process port)
- port)))))
+ (or (subprocess-%i/o-port process)
+ (let ((port
+ (let ((input-channel (subprocess-input-channel process))
+ (output-channel (subprocess-output-channel process)))
+ (and (or input-channel output-channel)
+ (make-generic-i/o-port input-channel output-channel)))))
+ (set-subprocess-%i/o-port! process port)
+ port)))
(define (subprocess-input-port process)
(let ((port (subprocess-i/o-port process)))
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
(and (cdr environment)
(->namestring (cdr environment))))
(set! environment (car environment))))
- (without-interrupts
+ (without-interruption
(lambda ()
(let ((index
(os/make-subprocess filename arguments environment
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)))
(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))
tick)))
(define (subprocess-global-status-tick)
- (without-interrupts
- (lambda ()
- (if ((ucode-primitive process-status-sync-all 0))
- (let ((tick (cons #f #f)))
- (set! global-status-tick tick)
- tick)
- global-status-tick))))
+ (if ((ucode-primitive process-status-sync-all 0))
+ (let ((tick (cons #f #f)))
+ (set! global-status-tick tick)
+ tick)
+ global-status-tick))
(define (convert-subprocess-status status)
(case status
projects / mit-scheme.git / commitdiff