~ chicken-core (chicken-5) 4e32262036806b2fc51964e518135fcd3de3a79b

commit 4e32262036806b2fc51964e518135fcd3de3a79b
Author:     Evan Hanson <evhan@foldling.org>
AuthorDate: Fri Sep 25 20:29:09 2015 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Sep 25 20:29:09 2015 +0200

    Avoid adding duplicate file descriptors when populating C_fdset_set
    
    Previously, when populating the C_fdset_set with pollfd entries before
    unblocking threads for i/o, an entry was added for each thread waiting
    on a given file descriptor, meaning multiple entries might be created
    for the same fd. Later code assumes that the C_fdset_set is a true set
    of fds, causing an assertion to fail. This patch changes `create-fdset`
    to ensure that each file descriptor appears once in the C_fdset_set,
    with the union of its input and output flags.

diff --git a/scheduler.scm b/scheduler.scm
index e31f6c89..f89805fa 100644
--- a/scheduler.scm
+++ b/scheduler.scm
@@ -387,26 +387,30 @@ EOF
   ((foreign-lambda void "C_prepare_fdset" int) (##sys#length ##sys#fd-list))
   (let loop ((lst ##sys#fd-list))
     (unless (null? lst)
-      (let ((fd (caar lst)))
+      (let ((fd (caar lst))
+	    (input #f)
+	    (output #f))
 	(for-each
 	 (lambda (t)
 	   (let ((p (##sys#slot t 11)))
-             (when (pair? p) ; (FD . RWFLAGS)? (can also be mutex or thread)
-               (fdset-set fd (cdr p)))))
+	     (when (pair? p) ; (FD . RWFLAGS)? (can also be mutex or thread)
+	       (let ((i/o (cdr p)))
+		 (case i/o
+		   ((#t #:input)
+		    (set! input #t))
+		   ((#f #:output)
+		    (set! output #t))
+		   ((#:all)
+		    (set! input #t)
+		    (set! output #t))
+		   (else
+		    (panic
+		     (sprintf "create-fdset: invalid i/o direction: ~S (fd = ~S)" i/o fd))))))))
 	 (cdar lst))
+	(when (or input output)
+	  ((foreign-lambda void "C_fdset_add" int bool bool) fd input output))
 	(loop (cdr lst))))))
 
-(define (fdset-set fd i/o)
-  (let ((fdset-add! (foreign-lambda void "C_fdset_add" int bool bool)))
-    (dbg "setting fdset for " fd " to " i/o)
-    (case i/o
-      ((#t #:input) (fdset-add! fd #t #f))
-      ((#f #:output) (fdset-add! fd #f #t))
-      ((#:all) (fdset-add! fd #t #t))
-      (else
-       (panic
-        (sprintf "fdset-set: invalid i/o direction: ~S (fd = ~S)" i/o fd))))))
-
 (define (fdset-test inf outf i/o)
   (case i/o
     ((#t #:input) inf)