[Scsh-checkins] CVS: scsh-0.6/scsh procobj.scm,1.11,1.12 sighandlers.scm,1.18,1.19 utilities.scm,1.4,1.5

[Martin Gasbichler <mainzelm@users.sourceforge.net>]

Update of /cvsroot/scsh/scsh-0.6/scsh
In directory usw-pr-cvs1:/tmp/cvs-serv30594

Modified Files:
        procobj.scm sighandlers.scm utilities.scm 
Log Message:
Kill the administrative threads on error.


Index: procobj.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/procobj.scm,v
retrieving revision 1.11
retrieving revision 1.12
diff -C2 -r1.11 -r1.12
*** procobj.scm 2001/07/07 19:29:29     1.11
--- procobj.scm 2001/10/03 14:41:01     1.12
***************
*** 173,184 ****
  (define (with-autoreaping thunk)
    (set! *autoreap-policy* 'early)
!   (spawn (lambda ()
!          (let lp ((event (most-recent-sigevent)))
!            (let ((next-event (next-sigevent event interrupt/chld)))
!              (*sigchld-handler*)
!              (lp next-event))))
!        '*sigchld-handler*-thread)
!   (thunk))
! 
  
  ;;; This list contains pids whose proc-obj were gc'd before they died
--- 173,183 ----
  (define (with-autoreaping thunk)
    (set! *autoreap-policy* 'early)
!   (run-as-long-as
!    (lambda ()
!      (let lp ((event (most-recent-sigevent)))
!        (let ((next-event (next-sigevent event interrupt/chld)))
!        (*sigchld-handler*)
!        (lp next-event))))
!    thunk))
  
  ;;; This list contains pids whose proc-obj were gc'd before they died

Index: sighandlers.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/sighandlers.scm,v
retrieving revision 1.18
retrieving revision 1.19
diff -C2 -r1.18 -r1.19
*** sighandlers.scm     2001/09/13 07:59:40     1.18
--- sighandlers.scm     2001/10/03 14:41:01     1.19
***************
*** 189,195 ****
                                   interrupt)
                                  (enum interrupt keyboard))))))
!   (spawn deliver-interrupts
!        'deliver-interrupts)
!   (thunk))
  
  (define (deliver-interrupts)
--- 189,193 ----
                                   interrupt)
                                  (enum interrupt keyboard))))))
!   (run-as-long-as deliver-interrupts thunk))
  
  (define (deliver-interrupts)

Index: utilities.scm
===================================================================
RCS file: /cvsroot/scsh/scsh-0.6/scsh/utilities.scm,v
retrieving revision 1.4
retrieving revision 1.5
diff -C2 -r1.4 -r1.5
*** utilities.scm       2001/07/09 18:29:26     1.4
--- utilities.scm       2001/10/03 14:41:01     1.5
***************
*** 268,269 ****
--- 268,290 ----
    (lambda (r)
      ((reinitializer-thunk r))))
+ 
+ ;--------------
+ ; Run thunk1 until thunk2 escapes
+ ; This is *extremly* low level
+ ; Don't use unless you know what you are doing
+ 
+ (define (run-as-long-as thunk1 thunk2)
+   (let ((thread (make-placeholder)))
+     (spawn (lambda ()
+            (placeholder-set! thread (current-thread))
+            (thunk1)))
+     (dynamic-wind
+      (lambda () #t)
+      thunk2
+      (lambda ()
+        (remove-thread-from-queues! (placeholder-value thread))
+        (kill-thread! (placeholder-value thread))
+        (make-ready (placeholder-value thread))))))
+ 
+     
+            
\ No newline at end of file