Index: scheduler.scm
===================================================================
--- scheduler.scm	(Revision 11689)
+++ scheduler.scm	(Arbeitskopie)
@@ -33,10 +33,11 @@
   (emit-exports "scheduler.exports")
   (disable-warning var)
   (hide ##sys#ready-queue-head ##sys#ready-queue-tail ##sys#timeout-list
+	##sys#current-ready-queue ##sys#remove-from-current-ready-queue
 	##sys#update-thread-state-buffer ##sys#restore-thread-state-buffer
 	##sys#remove-from-ready-queue ##sys#unblock-threads-for-i/o ##sys#force-primordial
 	##sys#fdset-input-set ##sys#fdset-output-set ##sys#fdset-clear
-	##sys#fdset-select-timeout ##sys#fdset-restore
+	##sys#fdset-select-timeout ##sys#fdset-restore ##sys#handle-bad-fd!
 	##sys#clear-i/o-state-for-thread!) 
   (foreign-declare #<<EOF
 #ifdef HAVE_ERRNO_H
@@ -60,6 +61,7 @@
 # include <sys/types.h>
 # include <sys/time.h>
 # include <time.h>
+# include <sys/stat.h>
 static C_word C_msleep(C_word ms);
 C_word C_msleep(C_word ms) {
 #ifdef __CYGWIN__
@@ -91,10 +93,24 @@
 #;(define-macro (dbg . args)
   `(print "DBG: " ,@args) )
 
+(define ##sys#current-ready-queue '())
 
+(define (##sys#remove-from-current-ready-queue)
+  (let ((h ##sys#current-ready-queue))
+    (or (and (pair? h)
+	     (let ((r (cdr h)))
+	       (set! ##sys#current-ready-queue r)
+	       (car h) ) )
+	(begin
+	  (set! ##sys#current-ready-queue ##sys#ready-queue-head)
+	  (set! ##sys#ready-queue-head '())
+	  (set! ##sys#ready-queue-tail '())
+	  (and (pair? ##sys#current-ready-queue)
+	       (##sys#remove-from-current-ready-queue)))) ) )
+
 (define (##sys#schedule)
   (define (switch thread)
-    (dbg "switching to " thread)
+    (dbg "switching to ~a" thread)
     (set! ##sys#current-thread thread)
     (##sys#setslot thread 3 'running)
     (##sys#restore-thread-state-buffer thread)
@@ -111,7 +127,7 @@
       (##sys#add-to-ready-queue ct) )
     (let loop1 ()
       ;; Unblock threads waiting for timeout:
-      (unless (null? ##sys#timeout-list)
+      (unless (or (pair? ##sys#current-ready-queue)) (null? ##sys#timeout-list)
 	(let ([now (##sys#fudge 16)])
 	  (dbg "timeout (" now ") list: " ##sys#timeout-list)
 	  (let loop ([lst ##sys#timeout-list])
@@ -145,12 +161,11 @@
       ;; Unblock threads blocked by I/O:
       (if eintr
 	  (##sys#force-primordial)
-	  (begin
-	    (unless (null? ##sys#fd-list)
-	      (##sys#unblock-threads-for-i/o) ) ) )
+	  (unless (or (pair? ##sys#current-ready-queue) (null? ##sys#fd-list))
+ 	   (##sys#unblock-threads-for-i/o) ) )
       ;; Fetch and activate next ready thread:
       (let loop2 ()
-	(let ([nt (##sys#remove-from-ready-queue)])
+	(let ([nt (##sys#remove-from-current-ready-queue)])
 	  (cond [(not nt) 
 		 (if (and (null? ##sys#timeout-list) (null? ##sys#fd-list))
 		     (##sys#signal-hook #:runtime-error "deadlock")
@@ -160,6 +175,7 @@
 
 (define (##sys#force-primordial)
   (dbg "primordial thread forced due to interrupt")
+  ;(display "switching to primordial thread\n" debug-port)
   (##sys#thread-unblock! ##sys#primordial-thread) )
 
 (define ##sys#ready-queue-head '())
@@ -341,6 +357,30 @@
   (##sys#setislot t 13 #f)
   (##sys#setslot t 11 (cons fd i/o)) )
 
+(define-foreign-variable error-bad-file int "(errno == EBADF)")
+
+(define (##sys#handle-bad-fd! e)
+  (dbg "check bad" e)
+  (let ((bad ((foreign-lambda*
+	       bool ((integer fd))
+	       "struct stat buf;"
+	       "int i = ( (fstat(fd, &buf) == -1 && errno == EBADF) ? 1 : 0);"
+	       "return(i);")
+	      (car e))))
+    (if bad
+	(for-each
+	 (lambda (thread)
+	   (thread-signal!
+	    thread
+	    (##sys#make-structure
+	     'condition
+	     '(exn i/o) ;; better? '(exn i/o net)
+	     (list '(exn . message) "bad file descriptor"
+		   '(exn . arguments) (car e)
+		   '(exn . location) thread) )))
+	 (cdr e)))
+    bad))
+
 (define (##sys#unblock-threads-for-i/o)
   (dbg "fd-list: " ##sys#fd-list)
   (let* ([to? (pair? ##sys#timeout-list)]
@@ -353,8 +393,23 @@
 		   (fxmax 0 (- tmo1 now)) )
 		 0) ) ] )		; otherwise immediate timeout.
     (dbg n " fds ready")
-    (cond [(eq? -1 n) 
-	   (##sys#force-primordial)]
+    (cond [(eq? -1 n)
+	   (cond
+	    (error-bad-file
+	     (set! ##sys#fd-list
+		   (let loop ((l ##sys#fd-list))
+		     (cond
+		      ((null? l) l)
+		      ((##sys#handle-bad-fd! (car l))
+		       (##sys#fdset-clear (caar l))
+		       ;; This is supposed to be a rare case, catch
+		       ;; them one by one.
+		       ;; (loop (cdr l))
+		       (cdr l))
+		      (else (cons (car l) (loop (cdr l)))))))
+	     (##sys#fdset-restore)
+	     (##sys#unblock-threads-for-i/o))
+	    (else (##sys#force-primordial))) ]
 	  [(fx> n 0)
 	   (set! ##sys#fd-list
 	     (let loop ([n n] [lst ##sys#fd-list])