scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ Spawn auto-reaping thread on root scheduler 

+ Don't mark a child dead if it simply received SIGSTOP.
This commit is contained in:
mainzelm 2002-06-10 08:38:57 +00:00
parent 1585024cd4
commit 8d0a620457
1 changed files with 4 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
scsh/procobj.scm
View File

@ -174,14 +174,14 @@
(define (with-autoreaping thunk) (define (with-autoreaping thunk)
(set! *autoreap-policy* 'early) (set! *autoreap-policy* 'early)
(run-as-long-as ((structure-ref threads-internal spawn-on-root)
(lambda () (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))))
thunk 'auto-reaping)
'auto-reaping)) (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
@ -241,7 +241,7 @@
(obtain-lock wait-lock) (obtain-lock wait-lock)
(receive (pid status) (receive (pid status)
(%wait-any (bitwise-ior wait/poll wait/stopped-children)) (%wait-any (bitwise-ior wait/poll wait/stopped-children))
(if pid (if (and pid (not (status:stop-sig status)))
(begin (waited-by-reap pid status) (begin (waited-by-reap pid status)
(release-lock wait-lock) (release-lock wait-lock)
; (format (current-error-port) ; (format (current-error-port)