[usocket-cvs] r389 - usocket/trunk/backend

[ehuelsmann at common-lisp.net]

Author: ehuelsmann
Date: Sun Jul 27 06:07:49 2008
New Revision: 389

Modified:
   usocket/trunk/backend/scl.lisp
Log:
Minimally change SCL backend to comply to new W-F-I protocol.

Modified: usocket/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp	(original)
+++ usocket/trunk/backend/scl.lisp	Sun Jul 27 06:07:49 2008
@@ -138,10 +138,27 @@
 (defun get-host-name ()
   (unix:unix-gethostname))
 
-(defun wait-for-input-internal (sockets &key timeout)
-  (let* ((pollfd-size (alien:alien-size (alien:struct unix::pollfd) :bytes))
-        (nfds (length sockets))
-        (bytes (* nfds pollfd-size)))
+
+;;
+;;
+;;  WAIT-LIST part
+;;
+
+
+(defun %add-waiter (wl waiter)
+  (declare (ignore wl waiter)))
+
+(defun %remove-waiter (wl waiter)
+  (declare (ignore wl waiter)))
+
+(defun %setup-wait-list (wl)
+  (declare (ignore wl)))
+
+(defun wait-for-input-internal (wait-list &key timeout)
+  (let* ((sockets (wait-list-waiters wait-list))
+         (pollfd-size (alien:alien-size (alien:struct unix::pollfd) :bytes))
+         (nfds (length sockets))
+         (bytes (* nfds pollfd-size)))
     (alien:with-bytes (fds-sap bytes)
       (do ((sockets sockets (rest sockets))
           (base 0 (+ base 8)))
@@ -163,11 +180,9 @@
                      (unix:get-unix-error-msg errno)))
              (t
               (do ((sockets sockets (rest sockets))
-                   (base 0 (+ base 8))
-                   (ready nil))
-                  ((endp sockets)
-                   (nreverse ready))
+                   (base 0 (+ base 8)))
+                  ((endp sockets))
                 (let ((flags (sys:sap-ref-16 fds-sap (+ base 6))))
                   (unless (zerop (logand flags unix::pollin))
-                    (push (first sockets) ready))))))))))
+                    (setf (state socket) :READ))))))))))