summaryrefslogtreecommitdiff
path: root/scsh-process.scm
diff options
context:
space:
mode:
Diffstat (limited to 'scsh-process.scm')
-rw-r--r--scsh-process.scm71
1 files changed, 39 insertions, 32 deletions
diff --git a/scsh-process.scm b/scsh-process.scm
index 3682c68..1a6c22b 100644
--- a/scsh-process.scm
+++ b/scsh-process.scm
@@ -115,11 +115,13 @@
(error 'process-wait
"Not a scsh-type process object or pid"
pid-or-process))
- ;; We need to make a copy because when waiting for #f, we
+ ;; We need to make a copy when waiting for #f, because we
;; can't predict which pid we'll receive, and the SIGCHLD
;; handler will drop the pid from the pending list.
(let ((pending-before
- (hash-table-copy *scsh-pending-processes*))
+ (if pid-or-process
+ *scsh-pending-processes*
+ (hash-table-copy *scsh-pending-processes*)))
(p (if (and pid-or-process (number? pid-or-process))
(hash-table-ref/default *scsh-pending-processes*
pid-or-process #f)
@@ -128,36 +130,41 @@
(values (scsh-process-exit-status p)
(scsh-process-ok? p)
(scsh-process-pid p))
- (if (and p (not nohang))
- (let lp ((m (make-mutex)))
- (mutex-unlock! m (scsh-process-child-condition p))
- (if (not (scsh-process-exit-status p))
- (lp m) ; might have been forcibly unblocked
- (values (scsh-process-exit-status p)
- (scsh-process-ok? p)
- (scsh-process-pid p))))
- (handle-exceptions exn
- (if (and p (scsh-process-exit-status p)) ; Signal might've occurred
- (values (scsh-process-exit-status p)
- (scsh-process-ok? p)
- (scsh-process-pid p))
- (abort exn))
- (receive (pid ok? status)
- (posix-process-wait (if p
- (scsh-process-pid p)
- pid-or-process) nohang)
- (cond
- ((zero? pid) (values #f #f #f))
- (else
- (and-let* ((p (or p (hash-table-ref/default
- pending-before pid #f))))
- (scsh-process-exit-status-set! p status)
- (scsh-process-ok?-set! p ok?)
- (condition-variable-broadcast!
- (scsh-process-child-condition p)))
-
- (remove-scsh-pending-process! pid)
- (values status ok? pid))))))))))
+ (handle-exceptions exn
+ (if (and p (scsh-process-exit-status p)) ; Signal might've occurred
+ (values (scsh-process-exit-status p)
+ (scsh-process-ok? p)
+ (scsh-process-pid p))
+ (abort exn))
+ (let lp ()
+ (receive (pid ok? status)
+ (posix-process-wait
+ (if p (scsh-process-pid p) pid-or-process)
+ ;; When we have p, "nohang" is ignored because
+ ;; the thread will hang on the condition var
+ ;; rather than letting the entire process hang.
+ (if p #t nohang))
+ (cond
+ ((zero? pid)
+ (if nohang
+ (values #f #f #f)
+ (let ((m (make-mutex)))
+ (mutex-unlock! m (scsh-process-child-condition p))
+ (if (not (scsh-process-exit-status p))
+ (lp) ; could be forcibly unblocked
+ (values (scsh-process-exit-status p)
+ (scsh-process-ok? p)
+ (scsh-process-pid p))))))
+ (else
+ (and-let* ((p (or p (hash-table-ref/default
+ pending-before pid #f))))
+ (scsh-process-exit-status-set! p status)
+ (scsh-process-ok?-set! p ok?)
+ (condition-variable-broadcast!
+ (scsh-process-child-condition p)))
+
+ (remove-scsh-pending-process! pid)
+ (values status ok? pid))))))))))
(set-signal-handler!
signal/chld