diff options
| author | Peter Bex <peter@more-magic.net> | 2017-11-18 13:19:28 +0100 |
|---|---|---|
| committer | Peter Bex <peter@more-magic.net> | 2017-11-18 13:19:28 +0100 |
| commit | dac7e59c6ccd22d36ba4de9c9c6c171c143eb9cc (patch) | |
| tree | 787d2f87122cbbf2ac4c1544bd0ccdc24ecdeb28 | |
| parent | bb04c5e4dedaa967e5a0b14efdea8c1514b6e223 (diff) | |
| download | scsh-process-dac7e59c6ccd22d36ba4de9c9c6c171c143eb9cc.tar.gz | |
Perform trial wait with "nohang" set to #t when blocking
We might have missed the one and only SIGCHLD event for the process
we're about to wait for, so attempt to reap it before entering the
condition variable wait loop.
Just in case, we always do this when we're woken up, so that we
can't accidentally miss the signal.
| -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 |