From 1b63d1f270b9407384f5f5f54776219294721fb9 Mon Sep 17 00:00:00 2001
From: mainzelm <mainzelm>
Date: Tue, 25 Feb 2003 08:11:32 +0000
Subject: [PATCH] Use with-sigevents to initialize the sigevent system. This
 also keeps track wether the thunk retuned in which case WAITING-FOR-SIGEVENT?
 will now always return #f.

This makes it possible for the root-scheduler to stop even though
there are threads waiting for signals.
---
 scheme/interfaces.scm    |  2 +-
 scheme/rts-packages.scm  |  3 ++-
 scheme/rts/init.scm      |  5 +++--
 scheme/rts/sigevents.scm | 23 ++++++++++++++++++-----
 4 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/scheme/interfaces.scm b/scheme/interfaces.scm
index 855f73f..45c2c26 100644
--- a/scheme/interfaces.scm
+++ b/scheme/interfaces.scm
@@ -655,7 +655,7 @@
 
 (define-interface rts-sigevents-internal-interface
   (export waiting-for-sigevent?
-	  initialize-sigevents!))
+	  with-sigevents))
 
 (define-interface writing-interface
   (export write
diff --git a/scheme/rts-packages.scm b/scheme/rts-packages.scm
index 4fb954d..68ba38a 100644
--- a/scheme/rts-packages.scm
+++ b/scheme/rts-packages.scm
@@ -226,6 +226,7 @@
 		    (rts-sigevents-internal rts-sigevents-internal-interface))
   (open scheme-level-1 define-record-types queues
 	threads threads-internal
+	wind
 	interrupts
 	architecture)
   (files (rts sigevents))
@@ -329,7 +330,7 @@
 	fluids-internal	 ;initialize-dynamic-state!
 	exceptions	 ;initialize-exceptions!
 	interrupts	 ;initialize-interrupts!
-	rts-sigevents-internal  ;initialize-sigevents!
+	rts-sigevents-internal  ;with-sigevents
 	records-internal ;initialize-records!
 	export-the-record-type	;just what it says
 	threads-internal ;start threads
diff --git a/scheme/rts/init.scm b/scheme/rts/init.scm
index 5b8d562..e66dec4 100644
--- a/scheme/rts/init.scm
+++ b/scheme/rts/init.scm
@@ -13,7 +13,9 @@
     (initialize-rts in out error
      (lambda ()
        (initialize-records! records)
-       (entry-point (vector->list resume-arg))))))
+       (with-sigevents
+	(lambda ()
+	  (entry-point (vector->list resume-arg))))))))
        
 (define (initialize-rts in out error thunk)
   (initialize-session-data!)
@@ -30,7 +32,6 @@
 	     (lambda ()
 	       (with-threads
 		(lambda ()
-		  (initialize-sigevents!)
 		  (root-scheduler thunk
 				  200           ; thread quantum, in msec
 				  300)))))))))) ; port-flushing quantum
diff --git a/scheme/rts/sigevents.scm b/scheme/rts/sigevents.scm
index 82ec67e..40073fc 100644
--- a/scheme/rts/sigevents.scm
+++ b/scheme/rts/sigevents.scm
@@ -58,21 +58,34 @@
 			 waiters))))))
     (for-each make-ready waiters)))
 
+
+;;; Records whether the sigevent system is running.
+;;; If set to #f we ignore threads waiting for a sigevent.
+(define sigevents-running? #f)
+
 ;;; has to be called with interrupts disabled
 (define (waiting-for-sigevent?)
-  (not (thread-queue-empty? sigevent-thread-queue)))
+  (if sigevents-running?
+      (not (thread-queue-empty? sigevent-thread-queue))
+      #f))
   
-(define (initialize-sigevents!)
+(define (with-sigevents thunk)
   (set! sigevent-thread-queue (make-queue))
   (set-interrupt-handler! (enum interrupt os-signal) 
 			  (lambda (type enabled-interrupts)
-                            ; type is already set in the unix signal handler
+					; type is already set in the unix signal handler
 			    (register-interrupt type)))
   (set-interrupt-handler! (enum interrupt keyboard) 
 			  (lambda (enabled-interrupts)
 			    (register-interrupt (enum interrupt keyboard))))
-;  (call-after-gc! (lambda () (register-interrupt (enum interrupt post-gc))))
-)
+  (dynamic-wind
+   (lambda ()
+     (set! sigevents-running? #t))
+   thunk
+   (lambda ()
+    (set! sigevents-running? #f))))
+     
+   
 ;;; the vm uses the timer for the scheduler
 (define (schedule-timer-interrupt! msec)
   (spawn (lambda ()