[usocket-cvs] r253 - usocket/trunk/backend
ehuelsmann at common-lisp.net
ehuelsmann at common-lisp.net
Tue May 22 21:35:59 UTC 2007
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...")
More information about the usocket-cvs
mailing list