From 71e3326079aaa9bce09b05d33f5208cc9101d08f Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Wed, 26 Jun 2002 10:02:10 +0000
Subject: [PATCH] Reintroduce run-as-long-as to ensure the threads exit on an
 error while evaluating -c and -s flags.

---
 scsh/procobj.scm     |  7 ++++---
 scsh/sighandlers.scm |  9 +++++----
 scsh/utilities.scm   | 19 ++++++++++++-------
 3 files changed, 21 insertions(+), 14 deletions(-)

diff --git a/scsh/procobj.scm b/scsh/procobj.scm
index 37f5dd6..3f3b9e0 100644
--- a/scsh/procobj.scm
+++ b/scsh/procobj.scm
@@ -174,14 +174,15 @@
 
 (define (with-autoreaping thunk)
   (set! *autoreap-policy* 'early)
-  ((structure-ref threads-internal spawn-on-root)
+  (run-as-long-as
    (lambda ()
      (let lp ((event (most-recent-sigevent)))
        (let ((next-event (next-sigevent event interrupt/chld)))
 	 (*sigchld-handler*)
 	 (lp next-event))))
-   'auto-reaping)
-  (thunk))
+   thunk
+   (structure-ref threads-internal spawn-on-root)
+   '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
diff --git a/scsh/sighandlers.scm b/scsh/sighandlers.scm
index ba74828..bc05a13 100644
--- a/scsh/sighandlers.scm
+++ b/scsh/sighandlers.scm
@@ -188,10 +188,11 @@
 				   (structure-ref threads-internal event-type) 
 				   interrupt)
 				  (enum interrupt keyboard))))))
-  ((structure-ref threads-internal spawn-on-root)
-   deliver-interrupts 
-   'deliver-interrupts)
-  (thunk))
+  (run-as-long-as
+   deliver-interrupts
+   thunk 
+   (structure-ref threads-internal spawn-on-root)
+   '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 d804030..f3fac88 100644
--- a/scsh/utilities.scm
+++ b/scsh/utilities.scm
@@ -273,19 +273,24 @@
 ; This is *extremly* low level
 ; Don't use unless you know what you are doing
 
-(define (run-as-long-as thunk1 thunk2 . name)
+(define (run-as-long-as thunk1 thunk2 spawn-thread . name)
   (let ((thread (make-placeholder)))
-    (apply spawn (lambda ()
-		   (placeholder-set! thread (current-thread))
-		   (thunk1))
+    (apply spawn-thread
+	   (lambda ()
+	     (placeholder-set! thread (current-thread))
+	     (thunk1))
 	   name)
     (dynamic-wind
      (lambda () #t)
      thunk2
      (lambda ()
-       (remove-thread-from-queues! (placeholder-value thread))
-       (kill-thread! (placeholder-value thread))
-       (make-ready (placeholder-value thread))))))
+       (savely-kill-thread! (placeholder-value thread))))))
 
+(define (savely-kill-thread! thread)
+  (remove-thread-from-queues! thread)
+  (kill-thread! thread)
+  (make-ready thread))
+
+  
     
 	     
\ No newline at end of file