[usocket-cvs] r294 - usocket/branches/0.3.x/backend

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Mon Sep 17 19:50:34 UTC 2007


Author: ehuelsmann
Date: Mon Sep 17 15:50:34 2007
New Revision: 294

Modified:
   usocket/branches/0.3.x/backend/allegro.lisp
   usocket/branches/0.3.x/backend/armedbear.lisp
   usocket/branches/0.3.x/backend/clisp.lisp
   usocket/branches/0.3.x/backend/cmucl.lisp
   usocket/branches/0.3.x/backend/lispworks.lisp
   usocket/branches/0.3.x/backend/openmcl.lisp
   usocket/branches/0.3.x/backend/sbcl.lisp
   usocket/branches/0.3.x/backend/scl.lisp
Log:
Manual backport of r288 from trunk.

Modified: usocket/branches/0.3.x/backend/allegro.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/allegro.lisp	(original)
+++ usocket/branches/0.3.x/backend/allegro.lisp	Mon Sep 17 15:50:34 2007
@@ -87,7 +87,8 @@
 
 (defmethod socket-accept ((socket stream-server-usocket) &key element-type)
   (declare (ignore element-type)) ;; allegro streams are multivalent
-  (let ((stream-sock (socket:accept-connection (socket socket))))
+  (let ((stream-sock (with-mapped-conditions ()
+                        (socket:accept-connection (socket socket)))))
     (make-stream-socket :socket stream-sock :stream stream-sock)))
 
 (defmethod get-local-address ((usocket usocket))

Modified: usocket/branches/0.3.x/backend/armedbear.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/armedbear.lisp	(original)
+++ usocket/branches/0.3.x/backend/armedbear.lisp	Mon Sep 17 15:50:34 2007
@@ -50,17 +50,20 @@
                                (host-to-hostname host) port))
          (sock (jnew-call ("java.net.ServerSocket"))))
     (when reuseaddress
+      (with-mapped-conditions ()
+         (jmethod-call sock
+                       ("setReuseAddress" "boolean")
+                       (java:make-immediate-object reuseaddress :boolean))))
+    (with-mapped-conditions ()
       (jmethod-call sock
-                    ("setReuseAddress" "boolean")
-                    (java:make-immediate-object reuseaddress :boolean)))
-    (jmethod-call sock
-                  ("bind" "java.net.SocketAddress" "int")
-                  sock-addr backlog)
+                    ("bind" "java.net.SocketAddress" "int")
+                    sock-addr backlog))
     (make-stream-server-socket sock :element-type element-type)))
 
 (defmethod socket-accept ((socket stream-server-usocket) &key element-type)
   (let* ((jsock (socket socket))
-         (jacc-sock (jmethod-call jsock ("accept")))
+         (jacc-sock (with-mapped-conditions (socket)
+                       (jmethod-call jsock ("accept")))
          (jacc-stream
           (ext:get-socket-stream jacc-sock
                                  :element-type (or element-type

Modified: usocket/branches/0.3.x/backend/clisp.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/clisp.lisp	(original)
+++ usocket/branches/0.3.x/backend/clisp.lisp	Mon Sep 17 15:50:34 2007
@@ -74,18 +74,20 @@
   ;; clisp 2.39 sets SO_REUSEADDRESS to 1 by default; no need to
   ;; to explicitly turn it on; unfortunately, there's no way to turn it off...
   (declare (ignore reuseaddress reuse-address))
-  (let ((sock (apply #'socket:socket-server
-                     (append (list port
-                                   :backlog backlog)
-                             (when (ip/= host *wildcard-host*)
-                               (list :interface host))))))
+  (let ((sock (with-mapped-conditions ()
+                  (apply #'socket:socket-server
+                         (append (list port
+                                       :backlog backlog)
+                                 (when (ip/= host *wildcard-host*)
+                                   (list :interface host)))))))
     (make-stream-server-socket sock :element-type element-type)))
 
 (defmethod socket-accept ((socket stream-server-usocket) &key element-type)
   (let ((stream
-         (socket:socket-accept (socket socket)
-                               :element-type (or element-type
-                                                 (element-type socket)))))
+         (with-mapped-conditions (socket)
+           (socket:socket-accept (socket socket)
+                                 :element-type (or element-type
+                                                   (element-type socket))))))
     (make-stream-socket :socket stream
                         :stream stream)))
 

Modified: usocket/branches/0.3.x/backend/cmucl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/cmucl.lisp	(original)
+++ usocket/branches/0.3.x/backend/cmucl.lisp	Mon Sep 17 15:50:34 2007
@@ -76,22 +76,25 @@
                            (backlog 5)
                            (element-type 'character))
  (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
-        (server-sock (apply #'ext:create-inet-listener
-                            (append (list port :stream
-                                          :backlog backlog
-                                          :reuse-address reuseaddress)
-                                    (when (ip/= host *wildcard-host*)
-                                      (list :host
-                                            (host-to-hbo host)))))))
+        (server-sock
+         (with-mapped-conditions ()
+           (apply #'ext:create-inet-listener
+                  (append (list port :stream
+                                :backlog backlog
+                                :reuse-address reuseaddress)
+                          (when (ip/= host *wildcard-host*)
+                            (list :host
+                                  (host-to-hbo host))))))))
    (make-stream-server-socket server-sock :element-type element-type)))
 
 (defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
-  (let* ((sock (ext:accept-tcp-connection (socket usocket)))
-         (stream (sys:make-fd-stream sock :input t :output t
-                                     :element-type (or element-type
-                                                       (element-type usocket))
-                                     :buffering :full)))
-    (make-stream-socket :socket sock :stream stream)))
+  (with-mapped-conditions (usocket)
+    (let* ((sock (ext:accept-tcp-connection (socket usocket)))
+           (stream (sys:make-fd-stream sock :input t :output t
+                                       :element-type (or element-type
+                                                         (element-type usocket))
+                                       :buffering :full)))
+      (make-stream-socket :socket sock :stream stream))))
 
 ;; Sockets and socket streams are represented
 ;; by different objects. Be sure to close the

Modified: usocket/branches/0.3.x/backend/lispworks.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/lispworks.lisp	(original)
+++ usocket/branches/0.3.x/backend/lispworks.lisp	Mon Sep 17 15:50:34 2007
@@ -87,7 +87,8 @@
     (make-stream-server-socket sock :element-type element-type)))
 
 (defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
-  (let* ((sock (comm::get-fd-from-socket (socket usocket)))
+  (let* ((sock (with-mapped-conditions (usocket)
+                  (comm::get-fd-from-socket (socket usocket))))
          (stream (make-instance 'comm:socket-stream
                                 :socket sock
                                 :direction :io

Modified: usocket/branches/0.3.x/backend/openmcl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/openmcl.lisp	(original)
+++ usocket/branches/0.3.x/backend/openmcl.lisp	Mon Sep 17 15:50:34 2007
@@ -92,19 +92,21 @@
                            (backlog 5)
                            (element-type 'character))
   (let* ((reuseaddress (if reuse-address-supplied-p reuse-address reuseaddress))
-         (sock (apply #'openmcl-socket:make-socket
-                      (append (list :connect :passive
-                                    :reuse-address reuseaddress
-                                    :local-port port
-                                    :backlog backlog
-                                    :format (to-format element-type))
-                              (when (ip/= host *wildcard-host*)
-                                (list :local-host host))))))
+         (sock (with-mapped-conditions ()
+                 (apply #'openmcl-socket:make-socket
+                        (append (list :connect :passive
+                                      :reuse-address reuseaddress
+                                      :local-port port
+                                      :backlog backlog
+                                      :format (to-format element-type))
+                                (when (ip/= host *wildcard-host*)
+                                  (list :local-host host)))))))
     (make-stream-server-socket sock :element-type element-type)))
 
 (defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
   (declare (ignore element-type)) ;; openmcl streams are bi/multivalent
-  (let ((sock (openmcl-socket:accept-connection (socket usocket))))
+  (let ((sock (with-mapped-conditions (usocket)
+                 (openmcl-socket:accept-connection (socket usocket)))))
     (make-stream-socket :socket sock :stream sock)))
 
 ;; One close method is sufficient because sockets

Modified: usocket/branches/0.3.x/backend/sbcl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/sbcl.lisp	(original)
+++ usocket/branches/0.3.x/backend/sbcl.lisp	Mon Sep 17 15:50:34 2007
@@ -136,18 +136,22 @@
          (ip (host-to-vector-quad host))
          (sock (make-instance 'sb-bsd-sockets:inet-socket
                               :type :stream :protocol :tcp)))
-    (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
-    (sb-bsd-sockets:socket-bind sock ip port)
-    (sb-bsd-sockets:socket-listen sock backlog)
-    (make-stream-server-socket sock :element-type element-type)))
+    (with-mapped-conditions ()
+      (setf (sb-bsd-sockets:sockopt-reuse-address sock) reuseaddress)
+      (sb-bsd-sockets:socket-bind sock ip port)
+      (sb-bsd-sockets:socket-listen sock backlog)
+      (make-stream-server-socket sock :element-type element-type))))
 
 (defmethod socket-accept ((socket stream-server-usocket) &key element-type)
-  (let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
-    (make-stream-socket :socket sock
-                        :stream (sb-bsd-sockets:socket-make-stream sock
-                                 :input t :output t :buffering :full
-                                 :element-type (or element-type
-                                                   (element-type socket))))))
+  (with-mapped-conditions (socket)
+    (let ((sock (sb-bsd-sockets:socket-accept (socket socket))))
+      (make-stream-socket
+       :socket sock
+       :stream (sb-bsd-sockets:socket-make-stream
+                sock
+                :input t :output t :buffering :full
+                :element-type (or element-type
+                                  (element-type socket)))))))
 
 ;; Sockets and their associated streams are modelled as
 ;; different objects. Be sure to close the stream (which

Modified: usocket/branches/0.3.x/backend/scl.lisp
==============================================================================
--- usocket/branches/0.3.x/backend/scl.lisp	(original)
+++ usocket/branches/0.3.x/backend/scl.lisp	Mon Sep 17 15:50:34 2007
@@ -50,19 +50,22 @@
          (host (if (ip= host *wildcard-host*)
                    0
                  (host-to-hbo host)))
-         (server-sock (ext:create-inet-listener port :stream
-                                                :host host
-                                                :reuse-address reuseaddress
-                                                :backlog backlog)))
+         (server-sock
+          (with-mapped-conditions ()
+            (ext:create-inet-listener port :stream
+                                      :host host
+                                      :reuse-address reuseaddress
+                                      :backlog backlog))))
    (make-stream-server-socket server-sock :element-type element-type)))
 
 (defmethod socket-accept ((usocket stream-server-usocket) &key element-type)
-  (let* ((sock (ext:accept-tcp-connection (socket usocket)))
-         (stream (sys:make-fd-stream sock :input t :output t
-                                     :element-type (or element-type
-                                                       (element-type usocket))
-                                     :buffering :full)))
-    (make-stream-socket :socket sock :stream stream)))
+  (with-mapped-conditions (usocket)
+    (let* ((sock (ext:accept-tcp-connection (socket usocket)))
+           (stream (sys:make-fd-stream sock :input t :output t
+                                       :element-type (or element-type
+                                                         (element-type usocket))
+                                       :buffering :full)))
+      (make-stream-socket :socket sock :stream stream))))
 
 ;; Sockets and their associated streams are modelled as
 ;; different objects. Be sure to close the socket stream



More information about the usocket-cvs mailing list