From ad18648afa5eb43aa897ae5fdcbf8d5b2c5536dd Mon Sep 17 00:00:00 2001
From: sperber <sperber>
Date: Fri, 17 Jan 2003 13:30:26 +0000
Subject: [PATCH] Fix some problems with WAIT-FOR-CHANNELS:

- Initialize READY-{READ,WRITE}-CHANNELS to () instead of #f, because
  the #f's don't get overwritten when the whole thing is interrupted.
- Fix the cleanup code which was conditionalized the wrong way.
---
 scheme/rts/channel-io.scm | 53 +++++++++++++++++++--------------------
 1 file changed, 26 insertions(+), 27 deletions(-)

diff --git a/scheme/rts/channel-io.scm b/scheme/rts/channel-io.scm
index 850aae4..3f24ae3 100644
--- a/scheme/rts/channel-io.scm
+++ b/scheme/rts/channel-io.scm
@@ -84,14 +84,14 @@
 	   (dynamic-wind nothing
 			 block
 			 (lambda ()
-			   (disable-interrupts!)
-			   (if (cell-ref cell)
-			       ;; we're being terminated
-			       (begin
-				 (fetch-channel-wait-cell! channel)
-				 (channel-abort channel)
-				 (wait-for-channel channel)))
-			   (enable-interrupts!))))))))
+			   (with-interrupts-inhibited
+			    (lambda ()
+			      (if (cell-ref cell)
+				  ;; we're being terminated
+				  (begin
+				    (fetch-channel-wait-cell! channel)
+				    (channel-abort channel)
+				    (wait-for-channel channel))))))))))))
 
 (define (nothing) #f)
 
@@ -108,8 +108,8 @@
 
   (let ((thread-cell (make-cell (current-thread)))
 	(ready-channels-cell (make-cell (cons '() '())))
-	(ready-read-channels #f)
-	(ready-write-channels #f))
+	(ready-read-channels '())
+	(ready-write-channels '()))
 
     (if (or (not timeout)
 	    (register-dozer thread-cell timeout))
@@ -138,23 +138,22 @@
 	   ;; clean up
 	   (lambda ()
 	     (let ((aborting? (and (cell-ref thread-cell) #t)))
-	       (disable-interrupts!)
-	       ;; this ain't so great ...
-	       (let ((make-cleanup
-		      (lambda (ready-channels)
-			(lambda (channel)
-			  (if (memq channel ready-channels)
-			      (begin
-				(fetch-channel-wait-cell! channel)
-				(if (not aborting?)
-				    (decrement-channel-wait-count!)
-				    (begin
-				      (channel-abort channel)
-				      (wait-for-channel channel)))))))))
-		 (for-each (make-cleanup ready-read-channels) read-channels)
-		 (for-each (make-cleanup ready-write-channels) write-channels))
-
-	       (enable-interrupts!)))))
+	       (with-interrupts-inhibited
+		(lambda ()
+		  ;; this ain't so great ...
+		  (let ((make-cleanup
+			 (lambda (ready-channels)
+			   (lambda (channel)
+			     (if (not (memq channel ready-channels))
+				 (begin
+				   (fetch-channel-wait-cell! channel)
+				   (if (not aborting?)
+				       (decrement-channel-wait-count!)
+				       (begin
+					 (channel-abort channel)
+					 (wait-for-channel channel)))))))))
+		    (for-each (make-cleanup ready-read-channels) read-channels)
+		    (for-each (make-cleanup ready-write-channels) write-channels))))))))
 	;; the timeout was zero or less
 	(enable-interrupts!))))