[usocket-cvs] r288 - in usocket/trunk: . backend

ehuelsmann at common-lisp.net ehuelsmann at common-lisp.net
Mon Sep 17 18:59:30 UTC 2007


Author: ehuelsmann
Date: Mon Sep 17 14:59:29 2007
New Revision: 288

Modified:
   usocket/trunk/backend/allegro.lisp
   usocket/trunk/backend/armedbear.lisp
   usocket/trunk/backend/clisp.lisp
   usocket/trunk/backend/lispworks.lisp
   usocket/trunk/backend/openmcl.lisp
   usocket/trunk/backend/sbcl.lisp
   usocket/trunk/usocket.lisp
Log:
Define datagram-usocket-p; ArmedBear depends on it.

Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp	(original)
+++ usocket/trunk/backend/allegro.lisp	Mon Sep 17 14:59:29 2007
@@ -89,7 +89,9 @@
 
 (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)
+            (socket:accept-connection (socket socket)))))
     (make-stream-socket :socket stream-sock :stream stream-sock)))
 
 (defmethod get-local-address ((usocket usocket))

Modified: usocket/trunk/backend/armedbear.lisp
==============================================================================
--- usocket/trunk/backend/armedbear.lisp	(original)
+++ usocket/trunk/backend/armedbear.lisp	Mon Sep 17 14:59:29 2007
@@ -216,19 +216,22 @@
                                     "open"))
          (sock (jdi:do-jmethod-call chan "socket")))
     (when reuseaddress
+      (with-mapped-conditions ()
+        (jdi:do-jmethod-call sock
+                             "setReuseAddress"
+                             (jdi:jcoerce reuseaddress :boolean))))
+    (with-mapped-conditions ()
       (jdi:do-jmethod-call sock
-                           "setReuseAddress"
-                           (jdi:jcoerce reuseaddress :boolean)))
-    (jdi:do-jmethod-call sock
-                         "bind"
-                         (jdi:jcoerce sock-addr
-                                      "java.net.SocketAddress")
-                         (jdi:jcoerce backlog :int))
+                           "bind"
+                           (jdi:jcoerce sock-addr
+                                        "java.net.SocketAddress")
+                           (jdi:jcoerce backlog :int)))
     (make-stream-server-socket chan :element-type element-type)))
 
 (defmethod socket-accept ((socket stream-server-usocket) &key element-type)
   (let* ((jsock (socket socket))
-         (jacc-chan (jdi:do-jmethod-call jsock "accept"))
+         (jacc-chan (with-mapped-conditions (socket)
+                       (jdi:do-jmethod-call jsock "accept")))
          (jacc-stream
           (ext:get-socket-stream (jdi:jop-deref
                                   (jdi:do-jmethod-call jacc-chan "socket"))
@@ -243,7 +246,7 @@
 
 (defmethod socket-close ((usocket usocket))
   (with-mapped-conditions (usocket)
-    (jdi:do-method (socket usocket) "close")))
+    (jdi:do-jmethod (socket usocket) "close")))
 
 ;; Socket streams are different objects than
 ;; socket streams. Closing the stream flushes

Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp	(original)
+++ usocket/trunk/backend/clisp.lisp	Mon Sep 17 14:59:29 2007
@@ -81,13 +81,15 @@
                                    :backlog backlog)
                              (when (ip/= host *wildcard-host*)
                                (list :interface host))))))
-    (make-stream-server-socket sock :element-type element-type)))
+    (with-mapped-conditions ()
+        (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/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp	(original)
+++ usocket/trunk/backend/lispworks.lisp	Mon Sep 17 14:59:29 2007
@@ -88,7 +88,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/trunk/backend/openmcl.lisp
==============================================================================
--- usocket/trunk/backend/openmcl.lisp	(original)
+++ usocket/trunk/backend/openmcl.lisp	Mon Sep 17 14:59:29 2007
@@ -94,19 +94,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/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp	(original)
+++ usocket/trunk/backend/sbcl.lisp	Mon Sep 17 14:59:29 2007
@@ -207,18 +207,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)
+       (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/trunk/usocket.lisp
==============================================================================
--- usocket/trunk/usocket.lisp	(original)
+++ usocket/trunk/usocket.lisp	Mon Sep 17 14:59:29 2007
@@ -58,6 +58,10 @@
 (defun stream-server-usocket-p (socket)
   (typep socket 'stream-server-usocket))
 
+(defun datagram-usocket-p (socket)
+  (declare (ignore socket))
+  nil)
+
 ;;Not in use yet:
 ;;(defclass datagram-usocket (usocket)
 ;;  ()



More information about the usocket-cvs mailing list