~ chicken-core (chicken-5) 8969da90e403c2fcdda2814c3b30243a1d0d2003

commit 8969da90e403c2fcdda2814c3b30243a1d0d2003
Author:     felix <felix@call-with-current-continuation.org>
AuthorDate: Tue Jun 21 10:12:16 2011 +0200
Commit:     felix <felix@call-with-current-continuation.org>
CommitDate: Tue Jun 21 10:12:16 2011 +0200

    Revert "also check for errors in select(2) call in scheduler; don't ignore sanity checks anymore"
    
    This reverts commit 3fe53ece5a210d5a67d7ebc764af038593b00824.
    
    This might break something and will be postponed until 4.7.2

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