added locks and renamed dead_by_ to waited-by-

This commit is contained in:
marting 1999-11-02 22:34:09 +00:00
parent c6860f767f
commit 582d032c53
1 changed files with 24 additions and 34 deletions

View File

@ -1,4 +1,4 @@
;;; Unix wait & process objects for scsh ;;; Unix waitt & process objects for scsh
;;; Copyright (c) 1993, 1994, 1995 by Olin Shivers. ;;; Copyright (c) 1993, 1994, 1995 by Olin Shivers.
;;; This is a GC'd abstraction for Unix process id's. ;;; This is a GC'd abstraction for Unix process id's.
@ -33,7 +33,7 @@
;; Maps pids to processes. Unexited processes are strong pointers, exited ;; Maps pids to processes. Unexited processes are strong pointers, exited
;; procs are weak pointers (to allow gc'ing). ;; procs are weak pointers (to allow gc'ing).
;; ;;
;; JMG: whyever unexited processes were strong pointer, this won't work ;; JMG: why ever unexited processes were strong pointer, this won't work
;; with (autoreap-policy 'late), since then gc waits for the strong pointer ;; with (autoreap-policy 'late), since then gc waits for the strong pointer
;; until it wait(2)s and the strong pointer waits for wait(2) which is ;; until it wait(2)s and the strong pointer waits for wait(2) which is
;; nothing but a deadlock ;; nothing but a deadlock
@ -60,6 +60,7 @@
(or (maybe-pid->proc pid) (or (maybe-pid->proc pid)
(case probe? (case probe?
((#f) (error "Pid has no corresponding process object" pid)) ((#f) (error "Pid has no corresponding process object" pid))
;;; TODO: call new-child-proc here
((create) (let ((p (make-procobj pid))) ; Install a new one. ((create) (let ((p (make-procobj pid))) ; Install a new one.
;; Weak because we don't know what's up with this thing. ;; Weak because we don't know what's up with this thing.
(weak-table-set! process-table pid p) (weak-table-set! process-table pid p)
@ -145,7 +146,7 @@
;;; New (scsh 0.6) ;;; New (scsh 0.6)
;;; we register the post/gc-handler not until the first police change ;;; we don't register the post/gc-handler until the first police change
(define (install-autoreaping) (define (install-autoreaping)
(let ((setter (low-interrupt-register interrupt/chld early-sigchld-handler))) (let ((setter (low-interrupt-register interrupt/chld early-sigchld-handler)))
(set! *autoreap-policy* 'early) (set! *autoreap-policy* 'early)
@ -157,21 +158,29 @@
;;; 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
(define need-reaping '()) (define need-reaping '())
(define need-reaping-lock (make-lock))
(define (need-reaping-add! pid) (define (need-reaping-add! pid)
(set! need-reaping (cons pid need-reaping))) (obtain-lock need-reaping-lock)
(set! need-reaping (cons pid need-reaping))
(release-lock need-reaping-lock))
(define (need-reaping-remove! pid) (define (need-reaping-remove! pid)
(set! need-reaping (del pid need-reaping))) (obtain-lock need-reaping-lock)
(set! need-reaping (del pid need-reaping))
(release-lock need-reaping-lock))
(define (reap-need-reaping) (define (reap-need-reaping)
(set! need-reaping (filter (lambda (pid) (not (reap-pid pid))) need-reaping))) (obtain-lock need-reaping-lock)
(set! need-reaping (filter (lambda (pid) (not (reap-pid pid))) need-reaping))
(release-lock need-reaping-lock))
;;; reap this special pid ;;; reap this special pid
;;; return status or #f ;;; return status or #f
(define (reap-pid pid) (define (reap-pid pid)
(let ((status (really-wait pid wait/poll))) (let ((status (really-wait pid wait/poll)))
(if status (if status
(dead_by_reap pid status)) (waited-by-reap pid status))
status)) status))
;;; Handler for SIGCHLD according policy ;;; Handler for SIGCHLD according policy
@ -189,10 +198,8 @@
;;; Finalizer for procobjs ;;; Finalizer for procobjs
;;; ;;;
(define (procobj-finalizer procobj) (define (procobj-finalizer procobj)
(display "procobj finalizer called")
(if (not (proc:finished? procobj)) (if (not (proc:finished? procobj))
(need-reaping-add! (proc:pid procobj)) (need-reaping-add! (proc:pid procobj))))
(display "but was already finished")))
;;; (reap-zombies) => bool ;;; (reap-zombies) => bool
@ -206,7 +213,7 @@
(receive (pid status) (%wait-any (bitwise-ior wait/poll (receive (pid status) (%wait-any (bitwise-ior wait/poll
wait/stopped-children)) wait/stopped-children))
(if pid (if pid
(begin (dead_by_reap pid status) (begin (waited-by-reap pid status)
(format (current-error-port) (format (current-error-port)
"Reaping ~d[~d]~%" pid status) "Reaping ~d[~d]~%" pid status)
(lp)) (lp))
@ -249,7 +256,7 @@
(let* ((flags (:optional maybe-flags 0)) (let* ((flags (:optional maybe-flags 0))
(proc (->proc pid/proc)) (proc (->proc pid/proc))
(win (lambda (status) (win (lambda (status)
(dead_by_wait proc status) (waited-by-wait proc status)
status))) status)))
(cond ((proc:finished? proc) (cond ((proc:finished? proc)
(win (placeholder-value (proc:status proc)))) (win (placeholder-value (proc:status proc))))
@ -282,29 +289,12 @@
(really-wait pid flags)) (really-wait pid flags))
(else (errno-error err %wait-pid pid flags))))) (else (errno-error err %wait-pid pid flags)))))
;;; Another way to do it:
;;; Every time we reap a process, we pop out of our SIGCHLD
;;; block so that we can service an interrupt if the system
;;; so wishes.
;(define (wait/pid pid)
; ((let lp ()
; (blocking signal/chld
; (or (waited pid) ; Previously waited or reaped
; (receive (next-dead status) (reap-a-pid)
; (if (= pid next-dead) (lambda () status)
; lp)))))))
;The above seems to use Olin's event model. Even so, I'm not
;sure that's the best way to do that.
;Generally correct idea, tho
;;; TODO: These 2 have to be renamed !!! ;;; TODO: These 2 have to be renamed !!!
;;; All you have to do, if pid was reaped ;;; All you have to do, if pid was reaped
;;; proc_obj is maybe no longer alive ;;; proc_obj is maybe no longer alive
(define (dead_by_reap pid status) (define (waited-by-reap pid status)
(cond ((maybe-pid->proc pid) => (cond ((maybe-pid->proc pid) =>
(lambda (proc) (lambda (proc)
(obituary proc status) (obituary proc status)
@ -313,14 +303,14 @@
;;; All you have to do, if a wait on proc was successful ;;; All you have to do, if a wait on proc was successful
(define (dead_by_wait proc status) (define (waited-by-wait proc status)
(obituary proc status) (obituary proc status)
(mark-proc-waited! proc)) (mark-proc-waited! proc))
;;; we know from somewhere that proc is dead ;;; we know from somewhere that proc is dead
(define (obituary proc status) (define (obituary proc status)
(if (not (proc? proc)) (if (not (proc? proc))
(error "proc was not a proc" proc)) (error "obituary: proc was not a procobj" proc))
(need-reaping-remove! (proc:pid proc)) ; in case it started during 'late (need-reaping-remove! (proc:pid proc)) ; in case it started during 'late
(placeholder-set! (proc:status proc) status) (placeholder-set! (proc:status proc) status)
(set-proc:finished? proc #t)) (set-proc:finished? proc #t))
@ -370,7 +360,7 @@
(receive (pid status) (%wait-any flags) (receive (pid status) (%wait-any flags)
(if pid (if pid
(let ((proc (new-child-proc pid))) (let ((proc (new-child-proc pid)))
(dead_by_wait proc status) (waited-by-wait proc status)
(values proc status)) (values proc status))
(values #f #f)))) (values #f #f))))
@ -394,7 +384,7 @@
(receive (pid status) (%wait-process-group proc-group flags) (receive (pid status) (%wait-process-group proc-group flags)
(if pid (if pid
(let ((proc (pid->proc pid))) (let ((proc (pid->proc pid)))
(dead_by_wait proc status) (waited-by-wait proc status)
(values proc status)) (values proc status))
(values pid status)))))) ; pid = #f -- Empty poll. (values pid status)))))) ; pid = #f -- Empty poll.