put process objects on top of event system

scsh/procobj.scm

@@ -108,6 +108,14 @@
 ;;; (autoreap-policy [new-policy])
 ;;; Watch this area
 
+
+;;; I'm really tired of opening everything (i.e. events) in scsh-level-0
+;;; this is here until someone (Olin !!!) cleans up the scsh modules
+
+(define wait-interrupt (structure-ref events wait-interrupt))
+(define most-recent-event (structure-ref events most-recent-event))
+
+
 (define *autoreap-policy* #f) ; Not exported from this module.
 
 (define (autoreap-policy . maybe-policy)
@@ -120,38 +128,54 @@
 		 (error "Illegal autoreap policy." new-policy))
 		(else (set! *autoreap-policy* new-policy)
 		      (cond ((eq? new-policy 'early)
-			     (sigchld-setter early-sigchld-handler)
+			     (set-sigchld-handler! early-sigchld-handler)
-			     (post/gc-setter (lambda a (reap-need-reaping))))
+			     (set-post/gc-handler! reap-need-reaping))
 			    
 			    ((eq? new-policy 'late)
-			     (sigchld-setter late-sigchld-handler)
+			     (set-sigchld-handler! late-sigchld-handler)
-			     (post/gc-setter (lambda a (reap-need-reaping))))
+			     (set-post/gc-handler! reap-need-reaping))
 
 			    (else 
-			     (sigchld-setter noauto-sigchld-handler)
+			     (set-sigchld-handler! noauto-sigchld-handler)
-			     (post/gc-setter 
+			     (set-post/gc-handler! 
-			      (lambda (enabled-ints)
+			      (lambda ()
-				(display "won't reap on gc since #f")))))))))
+				#f))))))))
     old-policy))
 
 
-(define sigchld-setter 
-  (lambda a (error "procobj setter was not defined")))
-
-(define (post/gc-setter handler)
-   (set! post/gc-setter 
-	    (low-interrupt-register interrupt/post-gc
-				handler)))
-  
-  
-
-;;; New (scsh 0.6)
 ;;; we don't register the post/gc-handler until the first police change
+;;; --- this made sense, but why?
+(define *post/gc-handler* 
+  (lambda () (error "*post/gc-handler* was not defined")))
+
+(define (really-set-post/gc-handler! handler)
+   (set! *post/gc-handler* handler))
+
+(define (start-set-post/gc-handler! handler)
+  (set! set-post/gc-handler! really-set-post/gc-handler!)
+  (set-post/gc-handler! handler)
+  (spawn (lambda ()
+	   (let lp ((event (most-recent-event)))
+	     (let ((next-event (wait-interrupt interrupt/post-gc event)))
+	       (*post/gc-handler*)
+	       (lp next-event))))
+	 '*post/gc-handler*-thread))
+  
+(define set-post/gc-handler! start-set-post/gc-handler!)
+
+
+(define (*sigchld-handler*) (early-sigchld-handler))
+(define (set-sigchld-handler! handler)
+  (set! *sigchld-handler* handler))
+
 (define (install-autoreaping) 
-  (let ((setter (low-interrupt-register interrupt/chld early-sigchld-handler)))
+  (set! *autoreap-policy* 'early)
-    (set! *autoreap-policy* 'early)
+  (spawn (lambda ()
-    (set! sigchld-setter setter)))
+	   (let lp ((event (most-recent-event)))
-      
+	     (let ((next-event (wait-interrupt interrupt/chld event)))
+	       (*sigchld-handler*)
+	       (lp next-event))))
+	 '*sigchld-handler*-thread))
 
 
 ;;; This list contains pids whose proc-obj were gc'd before they died
@@ -184,15 +208,12 @@
     status))
 	
 ;;; Handler for SIGCHLD according policy
-(define (late-sigchld-handler enabled-ints)
+(define (late-sigchld-handler) #f)
-  (display "late sigchld handler"))
 
-(define (early-sigchld-handler enabled-ints)
+(define (early-sigchld-handler)
   (reap-zombies))
 
-(define (noauto-sigchld-handler enabled-ints)
+(define (noauto-sigchld-handler) #f)
-  (display "won't on chld reap since #f")
-  #f)
 
 
 ;;; Finalizer for procobjs
@@ -248,9 +269,6 @@
 ;;; TODO: add a jetzt-wart-i lock
 
 (define (wait pid/proc . maybe-flags)
-  ;;; I'm really tired of opening everything in scsh-level-0
-  (let ((wait-interrupt (structure-ref events wait-interrupt))
-	(most-recent-event (structure-ref events most-recent-event)))
   (let* ((flags (:optional maybe-flags 0))
 	 (proc (->proc pid/proc))
 	 (win (lambda (status)
@@ -261,13 +279,13 @@
 	  
 	  ((zero? (bitwise-and flags wait/poll))   
 	   (let lp ()     ; we have to block and hence use the event system
-	      (wait-interrupt interrupt/chld (most-recent-event))
+	     (wait-interrupt interrupt/chld (most-recent-event))
-	      (cond ((wait proc (bitwise-ior flags wait/poll)) => win)
+	     (cond ((wait proc (bitwise-ior flags wait/poll)) => win)
-		    (else (lp)))))
+		   (else (lp)))))
-
+	  
 	  ((eq? wait/poll (bitwise-and flags wait/poll))
 	   (cond ((really-wait (proc:pid proc) flags) => win)
-		 (else #f)))))))
+		 (else #f))))))
 
 
 ;;; This one is used, to wait on a positive pid
@@ -333,7 +351,7 @@
 		       (values pid status))))
 
 	;The rest of this is quite crude and can be safely ignored. -df
-	;;; JMG: wait-any is crude and so it's implementation
+	;;; JMG: wait-any is crude and so its implementation
 	;;; It got even worse, now that we have this fu*$#%g 'late
 	(if (maybe-obtain-lock reaped-proc-pop-lock)
 	    (if (eq? reaped-proc-head reaped-proc-tail)