diff --git a/TODO b/TODO index 86f55b7..e631798 100644 --- a/TODO +++ b/TODO @@ -1,7 +1,5 @@ - Fix condition systems (making all implementation generate same error) - Add INET6 support. -- UDP support for Digitool MCL - IOlib backend -- SOCKET-OPTION (at least :BROADCAST and :READ-TIMEOUT) For more TODO items, see http://trac.common-lisp.net/usocket/report. diff --git a/backend/mcl.lisp b/backend/mcl.lisp index de7b84c..6e19286 100644 --- a/backend/mcl.lisp +++ b/backend/mcl.lisp @@ -47,7 +47,7 @@ (make-stream-socket :socket socket :stream stream)))) (:datagram (with-mapped-conditions () - (make-datagram-socket + (make-datagram-socket/mcl (ccl::open-udp-socket :local-address (and local-host (host-to-hbo local-host)) :local-port local-port)))))) @@ -241,3 +241,42 @@ #'ready-sockets (wait-list-waiters wait-list))) (nreverse result))) + +;;; datagram socket methods + +(defun make-datagram-socket/mcl (socket) + (unless socket + (error 'invalid-socket-error)) + (make-instance 'mcl-datagram-usocket + :socket socket)) + +(defclass mcl-datagram-usocket (datagram-usocket) + (inptr incount insize + outptr outcount outsize)) + +(defmethod initialize-instance :after ((usocket mcl-datagram-usocket) &key) + (with-slots ((outbuf send-buffer) (inbuf recv-buffer) + inptr incount insize + outptr outcount outsize) usocket + (setq insize +max-datagram-packet-size+ + outsize insize) + (setq inbuf (#_NewPtrClear :errchk insize) + inptr (ccl::%inc-ptr inbuf 0) + incount 0) + (setq outbuf (#_NewPtrClear :errchk outsize) + outptr (ccl::%inc-ptr outbuf 0) + outcount 0))) + +(defmethod socket-send ((usocket mcl-datagram-usocket) buffer size &key host port (offset 0)) + (with-mapped-conditions (usocket) + (with-slots ((outbuf send-buffer) + outptr outcount outsize) usocket + (if (and host port) + + (unsupported 'host 'socket-send))))) + +(defmethod socket-receive ((usocket mcl-datagram-usocket) buffer length &key) + (with-mapped-conditions (usocket) + (with-slots ((inbuf recv-buffer) + inptr incount insize) usocket + ))) diff --git a/usocket.lisp b/usocket.lisp index 09e4244..8573991 100644 --- a/usocket.lisp +++ b/usocket.lisp @@ -99,19 +99,17 @@ be initiated from remote sockets.")) ((connected-p :type boolean :accessor connected-p :initarg :connected-p) - #+(or cmu - scl - lispworks + #+(or cmu scl lispworks mcl (and clisp ffi (not rawsock))) (%open-p :type boolean :accessor %open-p :initform t - :documentation "Flag to indicate if usocket is open, + :documentation "Flag to indicate if usocket is open, for GC on implementions operate on raw socket fd.") - #+(or lispworks + #+(or lispworks mcl (and clisp ffi (not rawsock))) (recv-buffer :documentation "Private RECV buffer.") - #+lispworks + #+(or lispworks mcl) (send-buffer :documentation "Private SEND buffer.")) (:documentation "UDP (inet-datagram) socket")) diff --git a/vendor/OpenTransportUDP.lisp b/vendor/OpenTransportUDP.lisp index f9ff360..1c9e988 100644 --- a/vendor/OpenTransportUDP.lisp +++ b/vendor/OpenTransportUDP.lisp @@ -98,4 +98,3 @@ (setf (ot-conn-local-address conn) localaddress))) conn) (ot-error err :create))))) -