Index: debian/libchicken3.install
===================================================================
--- debian/libchicken3.install	(Revision 12259)
+++ debian/libchicken3.install	(Arbeitskopie)
@@ -1 +1 @@
-usr/lib/lib*.so.3
+usr/lib/lib*.so.4
Index: debian/chicken-bin.manpages
===================================================================
--- debian/chicken-bin.manpages	(Revision 12259)
+++ debian/chicken-bin.manpages	(Arbeitskopie)
@@ -1,6 +1,5 @@
 csc.1
 csi.1
 chicken.1
-chicken-setup.1
 chicken-profile.1
 chicken-bug.1
Index: debian/chicken-bin.dirs
===================================================================
--- debian/chicken-bin.dirs	(Revision 12259)
+++ debian/chicken-bin.dirs	(Arbeitskopie)
@@ -1 +1,2 @@
+usr/share/chicken
 var/lib/chicken
Index: scheduler.scm
===================================================================
--- scheduler.scm	(Revision 12259)
+++ scheduler.scm	(Arbeitskopie)
@@ -28,6 +28,7 @@
 (declare
   (fixnum)
   (unit scheduler)
+  (uses wttree)
   (disable-interrupts)
   (usual-integrations)
   (disable-warning var)
@@ -44,6 +45,7 @@
 #else
 # define C_signal_interrupted_p     C_SCHEME_FALSE
 #endif
+# include <sys/stat.h>
 
 #ifdef _WIN32
 # if _MSC_VER > 1300
@@ -90,12 +92,16 @@
  (hygienic-macros
   (define-syntax dbg
     (syntax-rules ()
-      ((_ . _) #f))) )
+      ((_ . _) #f)))
+  #;(define-syntax dbg
+    (syntax-rules ()
+      ((_ x ...) (begin (print x ...) (flush-output (current-output-port)))))) )
  (else
   (define-macro (dbg . args) #f)
   #;(define-macro (dbg . args)
   `(print "DBG: " ,@args) ) ) )
 
+(import wttree)
 
 (define (##sys#schedule)
   (define (switch thread)
@@ -140,7 +146,7 @@
 			    ;; but there are threads in the timeout list then sleep for
 			    ;; the number of milliseconds of next thread to wake up.
 			    (when (and (null? ##sys#ready-queue-head)
-				       (null? ##sys#fd-list) 
+				       (##sys#fd-list-empty?)
 				       (pair? ##sys#timeout-list))
 			      (let ([tmo1 (caar ##sys#timeout-list)])
 				(set! eintr
@@ -150,14 +156,13 @@
       ;; Unblock threads blocked by I/O:
       (if eintr
 	  (##sys#force-primordial)
-	  (begin
-	    (unless (null? ##sys#fd-list)
-	      (##sys#unblock-threads-for-i/o) ) ) )
+	  (unless (##sys#fd-list-empty?)
+ 	   (##sys#unblock-threads-for-i/o) ) )
       ;; Fetch and activate next ready thread:
       (let loop2 ()
 	(let ([nt (##sys#remove-from-ready-queue)])
 	  (cond [(not nt) 
-		 (if (and (null? ##sys#timeout-list) (null? ##sys#fd-list))
+		 (if (and (null? ##sys#timeout-list) (##sys#fd-list-empty?))
 		     (##sys#signal-hook #:runtime-error "deadlock")
 		     (loop1) ) ]
 		[(eq? (##sys#slot nt 3) 'ready) (switch nt)]
@@ -307,7 +312,10 @@
 
 ;;; `select()'-based blocking:
 
-(define ##sys#fd-list '())
+(define ##sys#fd-list #f)
+(define (##sys#empty-fd-list!) (set! ##sys#fd-list (make-wt-tree number-wt-type)))
+(##sys#empty-fd-list!)
+(define (##sys#fd-list-empty?) (wt-tree/empty? ##sys#fd-list))
 
 (define ##sys#fdset-select-timeout
   (foreign-lambda* int ([bool to] [unsigned-long tm])
@@ -342,13 +350,8 @@
 
 (define (##sys#thread-block-for-i/o! t fd i/o)
   (dbg t " blocks for I/O " fd)
-  (let loop ([lst ##sys#fd-list])
-    (if (null? lst) 
-	(set! ##sys#fd-list (cons (list fd t) ##sys#fd-list)) 
-	(let ([a (car lst)])
-	  (if (fx= fd (car a)) 
-	      (##sys#setslot a 1 (cons t (cdr a)))
-	      (loop (cdr lst)) ) ) ) )
+  (let ((entry (wt-tree/lookup ##sys#fd-list fd '())))
+    (if (not (memq t entry)) (wt-tree/add! ##sys#fd-list fd (cons t entry))))
   (case i/o
     ((#t #:input) (##sys#fdset-input-set fd))
     ((#f #:output) (##sys#fdset-output-set fd))
@@ -359,8 +362,10 @@
   (##sys#setislot t 13 #f)
   (##sys#setslot t 11 (cons fd i/o)) )
 
+(define-foreign-variable error-bad-file int "(errno == EBADF)")
+
 (define (##sys#unblock-threads-for-i/o)
-  (dbg "fd-list: " ##sys#fd-list)
+  (dbg "fd-list: " (wt-tree/fold (lambda (k v i) (cons (cons k v) i)) '() ##sys#fd-list))
   (let* ([to? (pair? ##sys#timeout-list)]
 	 [rq? (pair? ##sys#ready-queue-head)]
 	 [n (##sys#fdset-select-timeout	; we use FD_SETSIZE, but really should use max fd
@@ -371,32 +376,62 @@
 		   (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
+	     (call-with-current-continuation
+	      (lambda (exit)
+		(wt-tree/for-each
+		 (lambda (fd ts)
+		   (dbg "check bad " fd)
+		   (let ((bad ((foreign-lambda*
+				bool ((integer fd))
+				"struct stat buf;"
+				"int i = ( (fstat(fd, &buf) == -1 && errno == EBADF) ? 1 : 0);"
+				"return(i);")
+			       fd)))
+		     (when bad
+			   (dbg "bad is " fd)
+			   (##sys#fdset-clear fd)
+			   (wt-tree/delete! ##sys#fd-list fd)
+			   (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) (list fd)
+				      '(exn . location) thread) )))
+			    ts)
+			   (exit #t))))
+		 ##sys#fd-list)))
+	     (##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])
-	       (if (or (zero? n) (null? lst))
-		   lst
-		   (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 " ready: input=" inf ", output=" outf)
-		     (if (or inf outf)
-			 (let loop2 ([threads (cdr a)])
-			   (if (null? threads) 
-			       (begin
-				 (##sys#fdset-clear fd)
-				 (loop (sub1 n) (cdr lst)) )
-			       (let* ([t (car threads)]
-				      [p (##sys#slot t 11)] )
+	   (call-with-current-continuation
+	    (lambda (exit)
+	      (wt-tree/for-each
+	       (lambda (fd threads)
+		 (if (zero? n) (exit #f)
+		     (let* ([inf (##core#inline "C_fd_test_input" fd)]
+			    [outf (##core#inline "C_fd_test_output" fd)] )
+		      (dbg "fd " fd " ready: input=" inf ", output=" outf)
+		      (when (or inf outf)
+			    (for-each
+			     (lambda (t)
+			       (let* ((p (##sys#slot t 11)) )
 				 (when (and (pair? p)
 					    (eq? fd (car p))
 					    (not (##sys#slot t 13) ) ) ; not unblocked by timeout
-				   (##sys#thread-basic-unblock! t) )
-				 (loop2 (cdr threads)) ) ) )
-			 (cons a (loop n (cdr lst))) ) ) ) ) ) ] )
+				       (##sys#thread-basic-unblock! t) ) ))
+			     threads)
+			    (##sys#fdset-clear fd)
+			    (wt-tree/delete! ##sys#fd-list fd)
+			    (set! n (sub1 n)) ) )))
+	       ##sys#fd-list))) ] )
     (##sys#fdset-restore) ) )
 
 
@@ -404,24 +439,17 @@
 
 (define (##sys#clear-i/o-state-for-thread! t)
   (when (pair? (##sys#slot t 11))
-    (let ((fd (##sys#slot (##sys#slot t 11) 0)))
-      (set! ##sys#fd-list
-	(let loop ([lst ##sys#fd-list])
-	  (if (null? lst)
-	      '()
-	      (let* ([a (##sys#slot lst 0)]
-		     [fd2 (##sys#slot a 0)] )
-		(if (eq? fd fd2)
-		    (let ((ts (##sys#delq t (##sys#slot a 1)))) ; remove from fd-list entry
-		      (cond ((null? ts)
-			     ;;(pp `(CLEAR FD: ,fd ,t) ##sys#standard-error)
-			     (##sys#fdset-clear fd) ; no more threads waiting for this fd
-			     (##sys#fdset-restore)
-			     (##sys#slot lst 1) )
-			    (else
-			     (##sys#setslot a 1 ts) ; fd-list entry is list with t removed
-			     lst) ) )
-		    (cons a (loop (##sys#slot lst 1)))))))))))
+    (let* ((fd (##sys#slot (##sys#slot t 11) 0))
+	   (ts (wt-tree/lookup ##sys#fd-list fd #f)))
+      (when ts
+        (let ((ts (##sys#delq t ts))) ; remove from fd-list entry
+	  (cond ((null? ts)
+		 ;;(pp `(CLEAR FD: ,fd ,t) ##sys#standard-error)
+		 (##sys#fdset-clear fd) ; no more threads waiting for this fd
+		 (##sys#fdset-restore)
+		 (wt-tree/delete! ##sys#fd-list fd) )
+		(else
+		 (wt-tree/add! ##sys#fd-list fd ts)) ) ))))) ; fd-list entry is list with t removed
 
 
 ;;; Get list of all threads that are ready or waiting for timeout or waiting for I/O:
@@ -435,26 +463,19 @@
   (let loop ((l ##sys#ready-queue-head) (i init))
     (if (pair? l)
 	(loop (cdr l) (cns '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
-			    (cns 'i/o fd (car l) (loop (cdr l)))))))
-	      (let loop ((l ##sys#timeout-list) (i i))
-		(if (pair? l)
-		    (loop (cdr l) (cns 'timeout (caar l) (cdar l) i))
-		    i)))))))
+	(wt-tree/fold
+	 (lambda (fd ts i)
+	   (fold (lambda (t i) (cns 'i/o fd t i)) i ts))
+	 (fold (lambda (e i) (cns 'timeout (car e) (cdr e) i)) l ##sys#timeout-list)
+	 ##sys#fd-list))))
 
-
 ;;; Remove all waiting threads from the relevant queues with the exception of the current thread:
 
 (define (##sys#fetch-and-clear-threads)
   (let ([all (vector ##sys#ready-queue-head ##sys#ready-queue-tail ##sys#fd-list ##sys#timeout-list)])
     (set! ##sys#ready-queue-head '())
     (set! ##sys#ready-queue-tail '())
-    (set! ##sys#fd-list '())
+    (##sys#empty-fd-list!)
     (set! ##sys#timeout-list '()) 
     all) )
 
@@ -473,19 +494,10 @@
 (define (##sys#thread-unblock! t)
   (when (eq? 'blocked (##sys#slot t 3))
     (##sys#remove-from-timeout-list t)
-    (set! ##sys#fd-list 
-      (let loop ([fdl ##sys#fd-list])
-	(if (null? fdl)
-	    '()
-	    (let ([a (##sys#slot fdl 0)])
-	      (cons
-	       (cons (##sys#slot a 0)
-		     (##sys#delq t (##sys#slot a 1)) )
-	       (loop (##sys#slot fdl 1)) ) ) ) ) )
+    (##sys#clear-i/o-state-for-thread! t)
     (##sys#setislot t 12 '())
     (##sys#thread-basic-unblock! t) ) )
 
-
 ;;; Multithreaded breakpoints
 
 (define (##sys#break-entry name args)
Index: rules.make
===================================================================
--- rules.make	(Revision 12259)
+++ rules.make	(Arbeitskopie)
@@ -30,21 +30,21 @@
 
 LIBCHICKEN_OBJECTS_1 = \
        library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
-       srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex scheduler \
+       srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex wttree scheduler \
        profiler stub expand runtime
 LIBCHICKEN_SHARED_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=$(O))
 LIBCHICKEN_STATIC_OBJECTS = $(LIBCHICKEN_OBJECTS_1:=-static$(O))
 
 LIBUCHICKEN_OBJECTS_1 = \
        ulibrary ueval udata-structures uports ufiles uextras ulolevel uutils utcp usrfi-1 usrfi-4 \
-       usrfi-13 usrfi-14 usrfi-18 usrfi-69 u$(POSIXFILE) uregex scheduler \
+       usrfi-13 usrfi-14 usrfi-18 usrfi-69 u$(POSIXFILE) uregex wttree scheduler \
        profiler stub expand uruntime
 LIBUCHICKEN_SHARED_OBJECTS = $(LIBUCHICKEN_OBJECTS_1:=$(O))
 LIBUCHICKEN_STATIC_OBJECTS = $(LIBUCHICKEN_OBJECTS_1:=-static$(O))
 
 LIBCHICKENGUI_OBJECTS_1 = \
        library eval data-structures ports files extras lolevel utils tcp srfi-1 srfi-4 srfi-13 \
-       srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex scheduler \
+       srfi-14 srfi-18 srfi-69 $(POSIXFILE) regex wttree scheduler \
        profiler stub expand gui-runtime
 LIBCHICKENGUI_SHARED_OBJECTS = $(LIBCHICKENGUI_OBJECTS_1:=$(O))
 LIBCHICKENGUI_STATIC_OBJECTS = $(LIBCHICKENGUI_OBJECTS_1:=-static$(O))
@@ -141,6 +141,10 @@
 	$(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(PCRE_INCLUDES) \
 	  $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
 	  $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $(C_COMPILER_PCRE_OPTIONS) $< $(C_COMPILER_OUTPUT)
+wttree(O): wttree.c chicken.h $(CHICKEN_CONFIG_H)
+	$(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
+	  $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
+	  $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
 scheduler$(O): scheduler.c chicken.h $(CHICKEN_CONFIG_H)
 	$(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
 	  $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) $(C_COMPILER_SHARED_OPTIONS) \
@@ -316,6 +320,10 @@
 	$(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(PCRE_INCLUDES) \
 	  $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
 	  $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $(C_COMPILER_PCRE_OPTIONS) $< $(C_COMPILER_OUTPUT)
+wttree-static$(O): wttree.c chicken.h $(CHICKEN_CONFIG_H)
+	$(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
+	  $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
+	  $(C_COMPILER_BUILD_RUNTIME_OPTIONS) $< $(C_COMPILER_OUTPUT)
 scheduler-static$(O): scheduler.c chicken.h $(CHICKEN_CONFIG_H)
 	$(C_COMPILER) $(C_COMPILER_OPTIONS) $(C_COMPILER_PTABLES_OPTIONS) $(INCLUDES) \
 	  $(C_COMPILER_COMPILE_OPTION) $(C_COMPILER_OPTIMIZATION_OPTIONS) \
@@ -917,6 +925,7 @@
 	$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(DESTDIR)$(ILIBDIR) 
 	$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(DESTDIR)$(ICHICKENLIBDIR) 
 	$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(DESTDIR)$(IEGGDIR) 
+	$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(DESTDIR)$(IDATADIR)
 	$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(DESTDIR)$(IINCDIR)
 	$(MAKEDIR_COMMAND) $(MAKEDIR_COMMAND_OPTIONS) $(DESTDIR)$(IBINDIR)
 	$(INSTALL_PROGRAM) $(INSTALL_PROGRAM_STATIC_LIBRARY_OPTIONS) libchicken$(A) $(DESTDIR)$(ILIBDIR)
@@ -1158,7 +1167,9 @@
 	$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ 
 regex.c: $(SRCDIR)regex.scm
 	$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) $(CHICKEN_PCRE_LIBRARY_OPTIONS) -output-file $@ 
-scheduler.c: $(SRCDIR)scheduler.scm
+wttree.c: $(SRCDIR)wttree.scm
+	$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -unit wttree -emit-import-library wttree -output-file $@ 
+scheduler.c: $(SRCDIR)scheduler.scm wttree.c
 	$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ 
 profiler.c: $(SRCDIR)profiler.scm
 	$(CHICKEN) $< $(CHICKEN_LIBRARY_OPTIONS) -output-file $@ 
@@ -1290,7 +1301,7 @@
 
 distfiles: buildsvnrevision library.c eval.c expand.c data-structures.c ports.c files.c extras.c lolevel.c utils.c \
 	tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c \
-	posixunix.c posixwin.c regex.c scheduler.c profiler.c stub.c \
+	posixunix.c posixwin.c regex.c wttree.c scheduler.c profiler.c stub.c \
 	ulibrary.c ueval.c udata-structures.c uports.c ufiles.c uextras.c ulolevel.c \
 	uutils.c utcp.c usrfi-1.c usrfi-4.c usrfi-13.c usrfi-14.c \
 	usrfi-18.c usrfi-69.c uposixunix.c uposixwin.c uregex.c \
@@ -1330,7 +1341,7 @@
 spotless: distclean
 	-$(REMOVE_COMMAND) $(REMOVE_COMMAND_OPTIONS) library.c eval.c data-structures.c ports.c files.c extras.c lolevel.c utils.c \
 	  tcp.c srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c expand.c \
-	  posixunix.c posixwin.c regex.c scheduler.c profiler.c stub.c \
+	  posixunix.c posixwin.c regex.c wttree.c scheduler.c profiler.c stub.c \
 	  ulibrary.c ueval.c udata-structures.c uports.c ufiles.c uextras.c ulolevel.c \
 	  uutils.c utcp.c usrfi-1.c usrfi-4.c usrfi-13.c usrfi-14.c \
 	  usrfi-18.c usrfi-69.c uposixunix.c uposixwin.c uregex.c chicken-profile.c chicken-bug.c \
@@ -1386,4 +1397,4 @@
 $(SRCDIR)bootstrap.tar.gz: distfiles
 	tar cfz $@ library.c eval.c data-structures.c ports.c files.c extras.c lolevel.c utils.c tcp.c \
 	  srfi-1.c srfi-4.c srfi-13.c srfi-14.c srfi-18.c srfi-69.c posixunix.c posixwin.c regex.c \
-	  scheduler.c profiler.c stub.c expand.c $(COMPILER_OBJECTS_1:=.c)
+	  wttree.c scheduler.c profiler.c stub.c expand.c $(COMPILER_OBJECTS_1:=.c)