~ chicken-core (chicken-5) c2fabc00c2c88c0fb595bb61f2752858661330d3

commit c2fabc00c2c88c0fb595bb61f2752858661330d3
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 21 10:15:58 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jun 21 10:15:58 2011 +0200

    re-applied patch to enable sanity checks in scheduler

diff --git a/scheduler.scm b/scheduler.scm
index a3efc67c..a1a177e6 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -74,9 +74,10 @@ C_word C_msleep(C_word ms) {
   return C_SCHEME_TRUE;
 }
 #endif
-static fd_set C_fdset_input, C_fdset_output;
+static fd_set C_fdset_input, C_fdset_output, C_fdset_error;
 #define C_fd_test_input(fd)  C_mk_bool(FD_ISSET(C_unfix(fd), &C_fdset_input))
 #define C_fd_test_output(fd)  C_mk_bool(FD_ISSET(C_unfix(fd), &C_fdset_output))
+#define C_fd_test_error(fd)  C_mk_bool(FD_ISSET(C_unfix(fd), &C_fdset_error))
 EOF
 ) )
 
@@ -163,7 +164,7 @@ EOF
 	(let ([nt (remove-from-ready-queue)])
 	  (cond [(not nt) 
 		 (if (and (null? ##sys#timeout-list) (null? ##sys#fd-list))
-		     (##sys#halt "deadlock")
+		     (panic "deadlock")
 		     (loop1) ) ]
 		[(eq? (##sys#slot nt 3) 'ready) (switch nt)]
 		[else (loop2)] ) ) ) ) ) )
@@ -386,11 +387,11 @@ EOF
      (fdset-output-set fd) )
     (else (panic "fdset-set: invalid i/o direction"))))
 
-(define (fdset-test inf outf i/o)
+(define (fdset-test inf outf errf i/o)
   (case i/o
-    ((#t #:input) inf)
-    ((#f #:output) outf)
-    ((#:all) (or inf outf))
+    ((#t #:input) (or inf errf))
+    ((#f #:output) (or outf errf))
+    ((#:all) (or inf outf errf))
     (else (panic "fdset-test: invalid i/o direction"))))
 
 (define (##sys#thread-block-for-i/o! t fd i/o)
@@ -434,9 +435,10 @@ EOF
 		     (let* ([a (car lst)]
 			    [fd (car a)]
 			    [inf (##core#inline "C_fd_test_input" fd)]
-			    [outf (##core#inline "C_fd_test_output" fd)] )
-		       (dbg "fd " fd " state: input=" inf ", output=" outf)
-		       (if (or inf outf)
+			    [outf (##core#inline "C_fd_test_output" fd)]
+			    [errf (##core#inline "C_fd_test_error" fd)] )
+		       (dbg "fd " fd " state: input=" inf ", output=" outf ", error=" errf)
+		       (if (or inf outf errf)
 			   (let loop2 ((threads (cdr a)) (keep '()))
 			     (if (null? threads)
 				 (if (null? keep)
@@ -455,13 +457,9 @@ EOF
 					    (##sys#remove-from-timeout-list t))
 					  (##sys#thread-basic-unblock! t) 
 					  (loop2 (cdr threads) keep))
-					 ((or (not (eq? fd (car p)))
-					      ;; thread on fd-list has incorrect
-					      ;; file-descriptor registered. 
-					      ;; We just assume this is the right one and
-					      ;; unblock.
-					      ;; XXX Needs to be investigated...
-					      (fdset-test inf outf (cdr p)))
+					 ((not (eq? fd (car p)))
+					  (panic "thread is registered for I/O on unknown file-descriptor"))
+					 ((fdset-test inf outf errf (cdr p))
 					  (when (##sys#slot t 4) ; also blocked for timeout?
 					    (##sys#remove-from-timeout-list t))
 					  (##sys#thread-basic-unblock! t)