added locks and renamed dead_by_ to waited-by-

scsh/procobj.scm

@@ -1,4 +1,4 @@
-;;; Unix wait & process objects for scsh
+;;; Unix waitt & process objects for scsh
 ;;; Copyright (c) 1993, 1994, 1995 by Olin Shivers.
 
 ;;; 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
 ;; 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
 ;; until it wait(2)s and the strong pointer waits for wait(2) which is 
 ;; nothing but a deadlock
@@ -60,6 +60,7 @@
     (or (maybe-pid->proc pid)
 	(case probe?
 	  ((#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.
 		      ;; Weak because we don't know what's up with this thing.
 		      (weak-table-set! process-table pid p)
@@ -145,7 +146,7 @@
   
 
 ;;; 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)
   (let ((setter (low-interrupt-register interrupt/chld early-sigchld-handler)))
     (set! *autoreap-policy* 'early)
@@ -157,21 +158,29 @@
 ;;; We try to reap them after every gc and maybe on every SIGCHLD
 (define need-reaping '())
 
+(define need-reaping-lock (make-lock))
+
 (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)
-  (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)
- (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
 ;;; return status or #f 
 (define (reap-pid pid)
   (let ((status (really-wait pid wait/poll)))
     (if status 
-	(dead_by_reap pid status))
+	(waited-by-reap pid status))
     status))
 	
 ;;; Handler for SIGCHLD according policy
@@ -189,10 +198,8 @@
 ;;; Finalizer for procobjs
 ;;; 
 (define (procobj-finalizer procobj)
-  (display "procobj finalizer called")
   (if (not (proc:finished? procobj))
-      (need-reaping-add! (proc:pid procobj))
-      (display "but was already finished")))
+      (need-reaping-add! (proc:pid procobj))))
 
 
 ;;; (reap-zombies)  => bool
@@ -206,7 +213,7 @@
     (receive (pid status) (%wait-any (bitwise-ior wait/poll 
 						  wait/stopped-children))
       (if pid
-	  (begin (dead_by_reap pid status)
+	  (begin (waited-by-reap pid status)
 		 (format (current-error-port)
 			 "Reaping ~d[~d]~%" pid status)
 		 (lp))
@@ -249,7 +256,7 @@
   (let* ((flags (:optional maybe-flags 0))
 	 (proc (->proc pid/proc))
 	 (win (lambda (status)
-		(dead_by_wait proc status)
+		(waited-by-wait proc status)
 		status)))
     (cond ((proc:finished? proc)   
 	   (win (placeholder-value (proc:status proc))))
@@ -282,29 +289,12 @@
 		  (really-wait 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 !!!
 
 ;;; All you have to do, if pid was reaped
 ;;; proc_obj is maybe no longer alive
-(define (dead_by_reap pid status)
+(define (waited-by-reap pid status)
   (cond ((maybe-pid->proc pid) =>
 	 (lambda (proc) 
 	   (obituary proc status)
@@ -313,14 +303,14 @@
 
 
 ;;; 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)
   (mark-proc-waited! proc))
 
 ;;; we know from somewhere that proc is dead
 (define (obituary proc status)
   (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
   (placeholder-set! (proc:status proc) status)
   (set-proc:finished? proc #t))
@@ -370,7 +360,7 @@
     (receive (pid status) (%wait-any flags)
 			   (if pid
 			       (let ((proc (new-child-proc pid)))
-				 (dead_by_wait proc status)
+				 (waited-by-wait proc status)
 				 (values proc status))
 			       (values #f #f))))
       
@@ -394,7 +384,7 @@
       (receive (pid status) (%wait-process-group proc-group flags)
 	(if pid
 	    (let ((proc (pid->proc pid)))
-	      (dead_by_wait proc status)
+	      (waited-by-wait proc status)
 	      (values proc status))
 	    (values pid status))))))		; pid = #f -- Empty poll.