diff options
| -rw-r--r-- | scsh-process.scm | 71 |
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 |