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)
;; ()
