Author: ehuelsmann Date: Sat Feb 16 05:16:50 2008 New Revision: 308
Modified: usocket/trunk/backend/sbcl.lisp usocket/trunk/usocket.lisp Log: Don't loop over the sockets if we timed out...
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Sat Feb 16 05:16:50 2008 @@ -286,19 +286,19 @@ :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs))) - (if (=> count 0) - ;; process the result... - (remove-if - #'(lambda (x) - (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds))) - sockets) - (let ((err (sb-alien:get-errno))) - (unless (= err sb-unix:EINTR) - (error (map-errno-error err)))) - ;;###FIXME generate an error, except for EINTR - )))))) + (unless (= 0 count) ;; 0 means timeout + (if (=> count 0) + ;; process the result... + (remove-if + #'(lambda (x) + (not + (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor (socket x)) + rfds))) + sockets) + (let ((err (sb-alien:get-errno))) + (unless (= err sb-unix:EINTR) + (error (map-errno-error err)))))))))))
#+win32 (warn "wait-for-input not (yet!) supported...")
Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp (original) +++ usocket/trunk/usocket.lisp Sat Feb 16 05:16:50 2008 @@ -198,15 +198,23 @@
(defmethod wait-for-input (socket-or-sockets &key timeout) (let* ((start (get-internal-real-time)) + (sockets (if (listp socket-or-sockets) + socket-or-sockets + (list socket-or-sockets))) + ;; retrieve a list of all sockets which are ready without waiting + (ready-sockets + (remove-if (complement #'(lambda (x) + (and (stream-usocket-p x) + (listen (socket-stream x))))) + sockets)) ;; the internal routine is responsibe for ;; making sure the wait doesn't block on socket-streams of ;; which the socket isn't ready, but there's space left in the ;; buffer (result (wait-for-input-internal - (if (listp socket-or-sockets) socket-or-sockets - (list socket-or-sockets)) - :timeout timeout))) - (values result + sockets + :timeout (if (null ready-sockets) timeout 0)))) + (values (union ready-sockets result) (when timeout (let ((elapsed (/ (- (get-internal-real-time) start) internal-time-units-per-second)))