From 6671ff0e047004162d6bcdb3f48f00a788840acb Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Thu, 8 Nov 2001 08:14:37 +0000
Subject: [PATCH] + Fixed small race condition problem in wait. There are still
 problems   when lots of processes are forked + Added optional name parameter
 in run-as-long-as

---
 scsh/procobj.scm     | 11 ++++++-----
 scsh/sighandlers.scm |  2 +-
 scsh/utilities.scm   |  9 +++++----
 3 files changed, 12 insertions(+), 10 deletions(-)

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