Kill the administrative threads on error.
This commit is contained in:
parent
8c3cda1e0e
commit
9ec1d2ef5e
|
@ -172,14 +172,13 @@
|
||||||
|
|
||||||
(define (with-autoreaping thunk)
|
(define (with-autoreaping thunk)
|
||||||
(set! *autoreap-policy* 'early)
|
(set! *autoreap-policy* 'early)
|
||||||
(spawn (lambda ()
|
(run-as-long-as
|
||||||
(let lp ((event (most-recent-sigevent)))
|
(lambda ()
|
||||||
(let ((next-event (next-sigevent event interrupt/chld)))
|
(let lp ((event (most-recent-sigevent)))
|
||||||
(*sigchld-handler*)
|
(let ((next-event (next-sigevent event interrupt/chld)))
|
||||||
(lp next-event))))
|
(*sigchld-handler*)
|
||||||
'*sigchld-handler*-thread)
|
(lp next-event))))
|
||||||
(thunk))
|
thunk))
|
||||||
|
|
||||||
|
|
||||||
;;; This list contains pids whose proc-obj were gc'd before they died
|
;;; This list contains pids whose proc-obj were gc'd before they died
|
||||||
;;; We try to reap them after every gc and maybe on every SIGCHLD
|
;;; We try to reap them after every gc and maybe on every SIGCHLD
|
||||||
|
|
|
@ -188,9 +188,7 @@
|
||||||
(structure-ref threads-internal event-type)
|
(structure-ref threads-internal event-type)
|
||||||
interrupt)
|
interrupt)
|
||||||
(enum interrupt keyboard))))))
|
(enum interrupt keyboard))))))
|
||||||
(spawn deliver-interrupts
|
(run-as-long-as deliver-interrupts thunk))
|
||||||
'deliver-interrupts)
|
|
||||||
(thunk))
|
|
||||||
|
|
||||||
(define (deliver-interrupts)
|
(define (deliver-interrupts)
|
||||||
(let lp ((last ((structure-ref scsh-events most-recent-sigevent))))
|
(let lp ((last ((structure-ref scsh-events most-recent-sigevent))))
|
||||||
|
|
|
@ -267,3 +267,24 @@
|
||||||
(define-record-resumer :reinitializer
|
(define-record-resumer :reinitializer
|
||||||
(lambda (r)
|
(lambda (r)
|
||||||
((reinitializer-thunk r))))
|
((reinitializer-thunk r))))
|
||||||
|
|
||||||
|
;--------------
|
||||||
|
; Run thunk1 until thunk2 escapes
|
||||||
|
; This is *extremly* low level
|
||||||
|
; Don't use unless you know what you are doing
|
||||||
|
|
||||||
|
(define (run-as-long-as thunk1 thunk2)
|
||||||
|
(let ((thread (make-placeholder)))
|
||||||
|
(spawn (lambda ()
|
||||||
|
(placeholder-set! thread (current-thread))
|
||||||
|
(thunk1)))
|
||||||
|
(dynamic-wind
|
||||||
|
(lambda () #t)
|
||||||
|
thunk2
|
||||||
|
(lambda ()
|
||||||
|
(remove-thread-from-queues! (placeholder-value thread))
|
||||||
|
(kill-thread! (placeholder-value thread))
|
||||||
|
(make-ready (placeholder-value thread))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue