Index: scheduler.scm
===================================================================
--- scheduler.scm	(Revision 11967)
+++ scheduler.scm	(Arbeitskopie)
@@ -145,9 +147,8 @@
       ;; Unblock threads blocked by I/O:
       (if eintr
 	  (##sys#force-primordial)
-	  (begin
-	    (unless (null? ##sys#fd-list)
-	      (##sys#unblock-threads-for-i/o) ) ) )
+	  (unless (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)])
@@ -247,6 +248,14 @@
        (lambda (t2)
 	 (dbg "  checking: " t2 " (" (##sys#slot t2 3) ") -> " (##sys#slot t2 11))
 	 (when (eq? (##sys#slot t2 11) t)
+           (set! ##sys#timeout-list
+		 (let loop ((l ##sys#timeout-list))
+		   (if (null? l) 
+		       l
+		       (let ((h (##sys#slot l 0)))
+			 (if (eq? (##sys#slot h 1) t2)
+			     (##sys#slot l 1)
+			     (cons h (loop (##sys#slot l 1))))))))
 	   (##sys#thread-basic-unblock! t2) ) )
        rs) ) )
   (##sys#setislot t 12 '()) )
@@ -408,12 +456,28 @@
 
 ;;; Get list of all threads that are ready or waiting for timeout or waiting for I/O:
 
-(define (##sys#all-threads)
-  (append ##sys#ready-queue-head
-          (apply append (map cdr ##sys#fd-list))
-          (map cdr ##sys#timeout-list)))
+(define (##sys#all-threads . cons+init)
+  (let ((cons (if (null? cons+init)
+		  (lambda (queue arg val init)
+		    (cons val init))
+		  (car cons+init)))
+	(init (if (and (pair? cons+init) (pair? (cdr cons+init)))
+		  (cadr cons+init) '())))
+    (let loop ((l ##sys#ready-queue-head) (i init))
+      (if (pair? l)
+	  (loop (cdr l) (cons 'ready #f (car l) i))
+	  (let loop ((l ##sys#fd-list) (i i))
+	    (if (pair? l)
+		(loop (cdr l)
+		      (let ((fd (caar l)))
+			(let loop ((l (cdar l)))
+			  (if (null? l) i
+			      (cons 'i/o fd (car l) (loop (cdr l)))))))
+		(let loop ((l ##sys#timeout-list) (i i))
+		  (if (pair? l)
+		      (loop (cdr l) (cons 'timeout (caar l) (cdar l) i))
+		      i))))))))
 
-
 ;;; Remove all waiting threads from the relevant queues with the exception of the current thread:
 
 (define (##sys#fetch-and-clear-threads)