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...")