diff options
Diffstat (limited to 'scsh-process.scm')
| -rw-r--r-- | scsh-process.scm | 105 |
1 files changed, 70 insertions, 35 deletions
diff --git a/scsh-process.scm b/scsh-process.scm index 596a6b5..d6121c1 100644 --- a/scsh-process.scm +++ b/scsh-process.scm @@ -57,12 +57,12 @@ (cond-expand (chicken-5 (import (chicken base) (chicken condition) (chicken io) (chicken port) (chicken file) (chicken file posix) - (chicken string) - (chicken process) (chicken process signal) - srfi-18 srfi-69)) + (chicken string) (chicken process) + (chicken process signal) srfi-18 llrb-fixnum-table)) (else (import chicken) (use data-structures (rename extras (read-file read-list)) - utils files ports posix srfi-1 srfi-18 srfi-69))) + utils files ports posix srfi-1 srfi-18) + (use llrb-fixnum-table))) ;;;;;;;;;;;;;;;;;;;;;;;;; ;; Process bookkeeping ;; @@ -94,19 +94,47 @@ ;; Deprecated (define process? scsh-process?) -(define *scsh-pending-processes* (make-hash-table)) +(define-values + (clear-scsh-pending-processes! + add-scsh-pending-process! + scsh-pending-process-ref/default + remove-scsh-pending-process! + scsh-pending-process-fold + snapshot-scsh-pending-process) + (let () + +(define *scsh-pending-processes* (make-table)) (define (clear-scsh-pending-processes!) - (set! *scsh-pending-processes* (make-hash-table))) + (set! *scsh-pending-processes* (make-table))) (define (add-scsh-pending-process! pid) (let* ((c (make-condition-variable pid)) (process (make-scsh-process pid #f #f c))) - (hash-table-set! *scsh-pending-processes* pid process) + (table-update! *scsh-pending-processes* pid (lambda (x) process) (lambda () #f)) process)) +(define (scsh-pending-process-ref/default pid default) + (table-ref/default *scsh-pending-processes* pid default)) + (define (remove-scsh-pending-process! pid) - (hash-table-delete! *scsh-pending-processes* pid)) + (table-delete! *scsh-pending-processes* pid)) + +(define (scsh-pending-process-fold proc nil) + (table-fold *scsh-pending-processes* proc nil)) + +(define (snapshot-scsh-pending-process) + (let ((copy (table-copy *scsh-pending-processes*))) + (lambda (pid) (table-ref/default copy pid #f)))) + + (values + clear-scsh-pending-processes! + add-scsh-pending-process! + scsh-pending-process-ref/default + remove-scsh-pending-process! + scsh-pending-process-fold + snapshot-scsh-pending-process + ))) (define wait #f) @@ -128,11 +156,10 @@ ;; handler will drop the pid from the pending list. (let ((pending-before (if pid-or-process - *scsh-pending-processes* - (hash-table-copy *scsh-pending-processes*))) + #f + (snapshot-scsh-pending-process))) (p (if (and pid-or-process (number? pid-or-process)) - (hash-table-ref/default *scsh-pending-processes* - pid-or-process #f) + (scsh-pending-process-ref/default pid-or-process #f) pid-or-process))) (if (and p (scsh-process-exit-status p)) (values (scsh-process-exit-status p) @@ -164,8 +191,7 @@ (scsh-process-ok? p) (scsh-process-pid p)))))) (else - (and-let* ((p (or p (hash-table-ref/default - pending-before pid #f)))) + (and-let* ((p (or p (pending-before pid)))) (scsh-process-exit-status-set! p status) (scsh-process-ok?-set! p ok?) (condition-variable-broadcast! @@ -183,28 +209,37 @@ (syntax-rules () ((_ val) (the (or boolean (procedure (fixnum) . *)) val)))) (else (syntax-rules () ((_ val) val)))))) - (let ((old-handler (workaround (signal-handler signal/chld)))) + (let* ((old-handler (workaround (signal-handler signal/chld))) + (rst #f) ;; restart scan if true + (handler + ;; Run the signal handler in another thread. This is needed + ;; because the current thread may be waiting on a condition + ;; variable, and we can't wake ourselves up. + (thread-start! + (lambda () + (do () (#f) + (set! rst #f) + (scsh-pending-process-fold + (lambda (pid p i) + (and + p + (not (scsh-process-exit-status p)) + (receive (pid ok? status) + (posix-process-wait pid #t) + (if (and (not (zero? pid)) p) + (begin + (scsh-process-exit-status-set! p status) + (scsh-process-ok?-set! p ok?) + (condition-variable-broadcast! + (scsh-process-child-condition p)) + ;; The GC can clean it up + (remove-scsh-pending-process! pid)))))) + #f) + (unless rst (thread-suspend! (current-thread)))))) + )) (lambda (signal) - ;; Run the signal handler in another thread. This is needed - ;; because the current thread may be waiting on a condition - ;; variable, and we can't wake ourselves up. - (thread-start! - (lambda () - (for-each (lambda (pid) - (handle-exceptions exn - ;; User might have waited manually - (begin (remove-scsh-pending-process! pid) (void)) - (receive (pid ok? status) - (posix-process-wait pid #t) - (unless (zero? pid) - (let ((p (hash-table-ref *scsh-pending-processes* pid))) - (scsh-process-exit-status-set! p status) - (scsh-process-ok?-set! p ok?) - (condition-variable-broadcast! - (scsh-process-child-condition p)) - ;; The GC can clean it up - (remove-scsh-pending-process! pid)))))) - (hash-table-keys *scsh-pending-processes*)))) + (set! rst #t) + (thread-resume! handler) (when old-handler (old-handler signal))))))) (define (signal-process proc sig) |