summaryrefslogtreecommitdiff
path: root/scsh-process.scm
diff options
context:
space:
mode:
authorPeter Bex <peter@more-magic.net>2017-06-03 15:11:22 +0200
committerPeter Bex <peter@more-magic.net>2017-06-03 15:11:22 +0200
commit86310f955b1eb393a605a18ff9d734823c2b29df (patch)
tree0055f3e797bb7e22cfb0661afbd2bb890df9c95a /scsh-process.scm
parenta59e7d5159a6544085379609fec4a26dd214198f (diff)
downloadscsh-process-86310f955b1eb393a605a18ff9d734823c2b29df.tar.gz
Reinstall deadlock workaround thread when forking with thread killing
Diffstat (limited to 'scsh-process.scm')
-rw-r--r--scsh-process.scm19
1 files changed, 15 insertions, 4 deletions
diff --git a/scsh-process.scm b/scsh-process.scm
index 0676681..a5d3df6 100644
--- a/scsh-process.scm
+++ b/scsh-process.scm
@@ -73,9 +73,12 @@
;; Aaaand another hack to avoid getting "deadlock detected" when all
;; threads are waiting for a child condition. We can still get woken
;; up by the signal/chld handler (see below).
-(thread-start!
- (make-thread (lambda () (let lp () (thread-sleep! 100) (lp)))
- 'work-around-broken-deadlock-detection))
+(define (install-deadlock-workaround!)
+ (thread-start!
+ (make-thread (lambda () (let lp () (thread-sleep! 100) (lp)))
+ 'work-around-broken-deadlock-detection)))
+
+(install-deadlock-workaround!) ;; And again on fork
(define proc:pid scsh-process-pid)
(define proc? scsh-process?)
@@ -208,8 +211,15 @@
(exit 0)))
(define (fork #!optional thunk continue-threads?)
- (let* ((thunk (and thunk (lambda ()
+ (let* ((maybe-reinstall-deadlock-workaround!
+ (lambda ()
+ (cond-expand
+ (has-thread-killer
+ (unless continue-threads? (install-deadlock-workaround!)))
+ (else (void)))))
+ (thunk (and thunk (lambda ()
(clear-scsh-pending-processes!)
+ (maybe-reinstall-deadlock-workaround!)
(thunk))))
(pid (cond-expand
(has-thread-killer
@@ -218,6 +228,7 @@
(if thunk (process-fork thunk) (process-fork))))))
(cond ((zero? pid)
(clear-scsh-pending-processes!)
+ (maybe-reinstall-deadlock-workaround!)
#f)
(else (add-scsh-pending-process! pid)))))