diff --git a/scsh/procobj.scm b/scsh/procobj.scm index 37f5dd6..3f3b9e0 100644 --- a/scsh/procobj.scm +++ b/scsh/procobj.scm @@ -174,14 +174,15 @@ (define (with-autoreaping thunk) (set! *autoreap-policy* 'early) - ((structure-ref threads-internal spawn-on-root) + (run-as-long-as (lambda () (let lp ((event (most-recent-sigevent))) (let ((next-event (next-sigevent event interrupt/chld))) (*sigchld-handler*) (lp next-event)))) - 'auto-reaping) - (thunk)) + thunk + (structure-ref threads-internal spawn-on-root) + 'auto-reaping)) ;;; 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 diff --git a/scsh/sighandlers.scm b/scsh/sighandlers.scm index ba74828..bc05a13 100644 --- a/scsh/sighandlers.scm +++ b/scsh/sighandlers.scm @@ -188,10 +188,11 @@ (structure-ref threads-internal event-type) interrupt) (enum interrupt keyboard)))))) - ((structure-ref threads-internal spawn-on-root) - deliver-interrupts - 'deliver-interrupts) - (thunk)) + (run-as-long-as + deliver-interrupts + thunk + (structure-ref threads-internal spawn-on-root) + 'deliver-interrupts)) (define (deliver-interrupts) (let lp ((last ((structure-ref sigevents most-recent-sigevent)))) diff --git a/scsh/utilities.scm b/scsh/utilities.scm index d804030..f3fac88 100644 --- a/scsh/utilities.scm +++ b/scsh/utilities.scm @@ -273,19 +273,24 @@ ; This is *extremly* low level ; Don't use unless you know what you are doing -(define (run-as-long-as thunk1 thunk2 . name) +(define (run-as-long-as thunk1 thunk2 spawn-thread . name) (let ((thread (make-placeholder))) - (apply spawn (lambda () - (placeholder-set! thread (current-thread)) - (thunk1)) + (apply spawn-thread + (lambda () + (placeholder-set! thread (current-thread)) + (thunk1)) name) (dynamic-wind (lambda () #t) thunk2 (lambda () - (remove-thread-from-queues! (placeholder-value thread)) - (kill-thread! (placeholder-value thread)) - (make-ready (placeholder-value thread)))))) + (savely-kill-thread! (placeholder-value thread)))))) +(define (savely-kill-thread! thread) + (remove-thread-from-queues! thread) + (kill-thread! thread) + (make-ready thread)) + + \ No newline at end of file