[usocket-cvs] r317 - usocket/trunk/backend - usocket-cvs@common-lisp.net - mailman3.common-lisp.net

17 Feb 2008

Author: ehuelsmann
Date: Sun Feb 17 16:40:31 2008
New Revision: 317
Modified:
   usocket/trunk/backend/sbcl.lisp
Log:
Fix nameservice condition/error names; also revert some of r307: fast-unix-select *does* return errno,
but change the code a bit to prevent the compiler from issueing warnings.
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================

--- usocket/trunk/backend/sbcl.lisp	(original)
+++ usocket/trunk/backend/sbcl.lisp	Sun Feb 17 16:40:31 2008
@@ -162,8 +162,8 @@
;; Nameservice errors: mapped to unknown-error
     (sb-bsd-sockets:no-recovery-error . ns-no-recovery-error)
-    (sb-bsd-sockets:try-again-condition . ns-try-again-condition)
-    (sb-bsd-sockets:host-not-found . ns-host-not-found-error)))
+    (sb-bsd-sockets:try-again-error . ns-try-again-condition)
+    (sb-bsd-sockets:host-not-found-error . ns-host-not-found-error)))
(defun handle-condition (condition &optional (socket nil))
   "Dispatch correct usocket condition."
@@ -279,25 +279,24 @@
          (multiple-value-bind
              (secs musecs)
              (split-timeout (or timeout 1))
-           (let ((count
-		  (sb-unix:unix-fast-select
-		   (1+ (reduce #'max (mapcar #'socket sockets)
-			       :key #'sb-bsd-sockets:socket-file-descriptor))
-		   (sb-alien:addr rfds) nil nil
-		   (when timeout secs) musecs)))
-	     (unless (= 0 count)  ;; 0 means timeout
-	       (if (=> count 0)
+           (multiple-value-bind
+               (count err)
+               (sb-unix:unix-fast-select
+                (1+ (reduce #'max (mapcar #'socket sockets)
+                            :key #'sb-bsd-sockets:socket-file-descriptor))
+                (sb-alien:addr rfds) nil nil
+                (when timeout secs) musecs)
+	     (if (null count)
+		 (unless (= err sb-unix:EINTR)
+		   (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)
-		   (let ((err (sb-alien:get-errno)))
-		     (unless (= err sb-unix:EINTR)
-		       (error (map-errno-error err)))))))))))
+			(not (sb-unix:fd-isset
+			      (sb-bsd-sockets:socket-file-descriptor (socket x))
+			      rfds)))
+		    sockets))))))))
#+win32
   (warn "wait-for-input not (yet!) supported...")

    