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

[ehuelsmann at common-lisp.net]

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