summaryrefslogtreecommitdiff
path: root/scsh-process.scm
diff options
context:
space:
mode:
Diffstat (limited to 'scsh-process.scm')
-rw-r--r--scsh-process.scm105
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)