Kill the administrative threads on error.

This commit is contained in:
mainzelm 2001-10-03 14:41:01 +00:00
parent 8c3cda1e0e
commit 9ec1d2ef5e
3 changed files with 29 additions and 11 deletions

View File

@ -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
(lambda ()
(let lp ((event (most-recent-sigevent))) (let lp ((event (most-recent-sigevent)))
(let ((next-event (next-sigevent event interrupt/chld))) (let ((next-event (next-sigevent event interrupt/chld)))
(*sigchld-handler*) (*sigchld-handler*)
(lp next-event)))) (lp next-event))))
'*sigchld-handler*-thread) 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

View File

@ -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))))

View File

@ -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))))))