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

[Chun Tian (binghe)]

Author: ctian
Date: Wed Oct 22 14:00:57 2008
New Revision: 458

Log:
[trunk] merge changes on branch 0.4.x back to trunk.

Modified:
   usocket/trunk/backend/allegro.lisp
   usocket/trunk/backend/cmucl.lisp
   usocket/trunk/backend/sbcl.lisp
   usocket/trunk/backend/scl.lisp

Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp	(original)
+++ usocket/trunk/backend/allegro.lisp	Wed Oct 22 14:00:57 2008
@@ -58,24 +58,21 @@
 
   (let ((socket))
     (setf socket
-          (with-mapped-conditions (socket)
-            (if timeout
-                (mp:with-timeout (timeout nil)
-                  (socket:make-socket :remote-host (host-to-hostname host)
-                                      :remote-port port
-                                      :local-host (when local-host (host-to-hostname local-host))
-                                      :local-port local-port
-                                      :format (to-format element-type)
-                                      :nodelay nodelay))
-                (socket:make-socket :remote-host (host-to-hostname host)
-                                    :remote-port port
-                                    :local-host local-host
-                                    :local-port local-port
-                                    :format (to-format element-type)
-                                    :nodelay nodelay))))
+	  (labels ((make-socket ()
+		     (socket:make-socket :remote-host (host-to-hostname host)
+					 :remote-port port
+					 :local-host (when local-host
+						       (host-to-hostname local-host))
+					 :local-port local-port
+					 :format (to-format element-type)
+					 :nodelay nodelay)))
+	    (with-mapped-conditions (socket)
+	      (if timeout
+		  (mp:with-timeout (timeout nil)
+		    (make-socket))
+		  (make-socket)))))
     (make-stream-socket :socket socket :stream socket)))
 
-
 ;; One socket close method is sufficient,
 ;; because socket-streams are also sockets.
 (defmethod socket-close ((usocket usocket))

Modified: usocket/trunk/backend/cmucl.lisp
==============================================================================
--- usocket/trunk/backend/cmucl.lisp	(original)
+++ usocket/trunk/backend/cmucl.lisp	Wed Oct 22 14:00:57 2008
@@ -92,7 +92,7 @@
         (server-sock
          (with-mapped-conditions ()
            (apply #'ext:create-inet-listener
-                  (append (list port :stream
+                  (nconc  (list port :stream
                                 :backlog backlog
                                 :reuse-address reuseaddress)
                           (when (ip/= host *wildcard-host*)

Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp	(original)
+++ usocket/trunk/backend/sbcl.lisp	Wed Oct 22 14:00:57 2008
@@ -319,9 +319,9 @@
      (sb-bsd-sockets::host-ent-addresses
          (sb-bsd-sockets:get-host-by-name name))))
 
-#+sbcl
+#+(and sbcl (not win32))
 (progn
-  #-win32
+
 (defun %setup-wait-list (wait-list)
   (declare (ignore wait-list)))
 
@@ -363,10 +363,10 @@
                              (socket x))
                             rfds)
                        (setf (state x) :READ))))))))))
+) ; progn
 
-  #+win32
+#+(and sbcl win32)
   (warn "wait-for-input not (yet!) supported...")
-  )
 
 #+ecl
 (progn

Modified: usocket/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp	(original)
+++ usocket/trunk/backend/scl.lisp	Wed Oct 22 14:00:57 2008
@@ -45,7 +45,8 @@
 
   (let* ((socket (let ((args (list (host-to-hbo host) port :kind :stream)))
 		   (when (and patch-udp-p (or local-host-p local-port-p))
-		     (nconc args (list :local-host local-host :local-port local-port)))
+		     (nconc args (list :local-host (host-to-hbo local-host)
+				       :local-port local-port)))
 		   (with-mapped-conditions ()
 		     (apply #'ext:connect-to-inet-socket args))))
          (stream (sys:make-fd-stream socket :input t :output t