[usocket-cvs] r361 - usocket/branches/new-wfi/backend

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Thu Jul  3 18:33:36 2008
New Revision: 361

Modified:
   usocket/branches/new-wfi/backend/sbcl.lisp
Log:
Fix SBCL backend (non Win32).

Modified: usocket/branches/new-wfi/backend/sbcl.lisp
==============================================================================
--- usocket/branches/new-wfi/backend/sbcl.lisp	(original)
+++ usocket/branches/new-wfi/backend/sbcl.lisp	Thu Jul  3 18:33:36 2008
@@ -268,13 +268,26 @@
 #+sbcl
 (progn
   #-win32
+(defun %setup-wait-list (wait-list)
+  (declare (ignore wait-list)))
+
+(defun %add-waiter (wait-list waiter)
+  (push (socket waiter) (wait-list-%wait wait-list)))
+
+(defun %remove-waiter (wait-list waiter)
+  ;;;### not removing from the waiters list?!
+  (setf (wait-list-%wait wait-list)
+        (remove (socket waiter) (wait-list-%wait wait-list))))
+
+
+
   (defun wait-for-input-internal (sockets &key timeout)
     (with-mapped-conditions ()
       (sb-alien:with-alien ((rfds (sb-alien:struct sb-unix:fd-set)))
          (sb-unix:fd-zero rfds)
-         (dolist (socket sockets)
+         (dolist (socket (wait-list-%wait sockets))
            (sb-unix:fd-set
-            (sb-bsd-sockets:socket-file-descriptor (socket socket))
+            (sb-bsd-sockets:socket-file-descriptor socket)
             rfds))
          (multiple-value-bind
              (secs musecs)
@@ -282,7 +295,7 @@
            (multiple-value-bind
                (count err)
                (sb-unix:unix-fast-select
-                (1+ (reduce #'max (mapcar #'socket sockets)
+                (1+ (reduce #'max (mapcar #'socket (wait-list-waiters sockets))
                             :key #'sb-bsd-sockets:socket-file-descriptor))
                 (sb-alien:addr rfds) nil nil
                 (when timeout secs) musecs)
@@ -291,12 +304,11 @@
 		   (error (map-errno-error err)))
 		 (when (< 0 count)
 		   ;; process the result...
-		   (remove-if
-		    #'(lambda (x)
-			(not (sb-unix:fd-isset
-			      (sb-bsd-sockets:socket-file-descriptor (socket x))
-			      rfds)))
-		    sockets))))))))
+                   (dolist (x (wait-list-waiters sockets))
+                     (when (not (sb-unix:fd-isset
+                                 (sb-bsd-sockets:socket-file-descriptor (socket x))
+                                 rfds))
+                       (setf (state x) :READ))))))))))
 
   #+win32
   (warn "wait-for-input not (yet!) supported...")