diff --git a/scsh/procobj.scm b/scsh/procobj.scm index fde5edf..324c2e2 100644 --- a/scsh/procobj.scm +++ b/scsh/procobj.scm @@ -178,7 +178,8 @@ (let ((next-event (next-sigevent event interrupt/chld))) (*sigchld-handler*) (lp next-event)))) - thunk)) + thunk + '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 @@ -290,10 +291,10 @@ ((zero? (bitwise-and flags wait/poll)) (release-lock wait-lock) ; we have to block and hence use the event system - (let lp ((pre-event pre-event)) - (let ((event (next-sigevent pre-event interrupt/chld))) - (cond ((wait proc (bitwise-ior flags wait/poll)) => win) - (else (lp event)))))) + (let lp ((pre-event pre-event)) + (cond ((wait proc (bitwise-ior flags wait/poll)) => win) + (else + (lp (next-sigevent pre-event interrupt/chld)))))) ((eq? wait/poll (bitwise-and flags wait/poll)) (cond ((really-wait (proc:pid proc) flags) => win) diff --git a/scsh/sighandlers.scm b/scsh/sighandlers.scm index 8c7fe4d..ba9028a 100644 --- a/scsh/sighandlers.scm +++ b/scsh/sighandlers.scm @@ -188,7 +188,7 @@ (structure-ref threads-internal event-type) interrupt) (enum interrupt keyboard)))))) - (run-as-long-as deliver-interrupts thunk)) + (run-as-long-as deliver-interrupts thunk '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 9eb4db7..d804030 100644 --- a/scsh/utilities.scm +++ b/scsh/utilities.scm @@ -273,11 +273,12 @@ ; This is *extremly* low level ; Don't use unless you know what you are doing -(define (run-as-long-as thunk1 thunk2) +(define (run-as-long-as thunk1 thunk2 . name) (let ((thread (make-placeholder))) - (spawn (lambda () - (placeholder-set! thread (current-thread)) - (thunk1))) + (apply spawn (lambda () + (placeholder-set! thread (current-thread)) + (thunk1)) + name) (dynamic-wind (lambda () #t) thunk2