Author: ehuelsmann Date: Tue May 22 17:35:58 2007 New Revision: 253
Modified: usocket/trunk/backend/cmucl.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp Log: Small but important changes to various backends as a result of more heavy testing.
Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp (original) +++ usocket/trunk/backend/cmucl.lisp Tue May 22 17:35:58 2007 @@ -165,6 +165,7 @@
(defun wait-for-input-internal (sockets &key timeout) (alien:with-alien ((rfds (alien:struct unix:fd-set))) + (unix:fd-zero rfds) (dolist (socket sockets) (unix:fd-set (socket socket) rfds)) (multiple-value-bind @@ -176,12 +177,11 @@ :key #'socket)) (alien:addr rfds) nil nil (when timeout secs) musecs) - (if (= 0 err) + (if (<= 0 count) ;; process the result... - (unless (= 0 count) - (remove-if #'(lambda (x) - (not (unix:fd-isset (socket x) rfds))) - sockets)) + (remove-if #'(lambda (x) + (not (unix:fd-isset (socket x) rfds))) + sockets) (progn ;;###FIXME generate an error, except for EINTR ))))))
Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp (original) +++ usocket/trunk/backend/openmcl.lisp Tue May 22 17:35:58 2007 @@ -39,18 +39,15 @@ (defun input-available-p (sockets &optional ticks-to-wait) (ccl::rletZ ((tv :timeval)) (ccl::ticks-to-timeval ticks-to-wait tv) - (ccl::%stack-block ((infds ccl::*fd-set-size*) - (errfds ccl::*fd-set-size*)) + (ccl::%stack-block ((infds ccl::*fd-set-size*)) (ccl::fd-zero infds) - (ccl::fd-zero errfds) (let ((max-fd -1)) (dolist (sock sockets) (let ((fd (openmcl-socket:socket-os-fd sock))) (setf max-fd (max max-fd fd)) - (ccl::fd-set fd infds) - (ccl::fd-set fd errfds))) + (ccl::fd-set fd infds))) (let* ((res (ccl::syscall syscalls::select (1+ max-fd) - infds (ccl::%null-ptr) errfds + infds (ccl::%null-ptr) (ccl::%null-ptr) (if ticks-to-wait tv (ccl::%null-ptr))))) (when (> res 0) (remove-if #'(lambda (x)
Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Tue May 22 17:35:58 2007 @@ -255,6 +255,7 @@ #-win32 (defun wait-for-input-internal (sockets &key timeout) (sb-alien:with-alien ((rfds (sb-alien:struct sb-unix:fd-set))) + (sb-unix:fd-zero rfds) (dolist (socket sockets) (sb-unix:fd-set (sb-bsd-sockets:socket-file-descriptor (socket socket)) rfds)) @@ -268,18 +269,19 @@ :key #'sb-bsd-sockets:socket-file-descriptor)) (sb-alien:addr rfds) nil nil (when timeout secs) musecs) - (if (= 0 err) + (if (<= 0 count) ;; process the result... - (unless (= 0 count) - (remove-if - #'(lambda (x) - (not (sb-unix:fd-isset - (sb-bsd-sockets:socket-file-descriptor (socket x)) - rfds))) - sockets)) + (remove-if + #'(lambda (x) + (not (sb-unix:fd-isset + (sb-bsd-sockets:socket-file-descriptor (socket x)) + rfds))) + sockets) (progn + (unless (= err sb-unix:EINTR) + (error (map-errno-error err)))) ;;###FIXME generate an error, except for EINTR - )))))) + )))))
#+win32 (warn "wait-for-input not (yet!) supported...")