[MCL] mcl-datagram-usocket with I/O buffers

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.

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
+      )))

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"))
 

vendor/OpenTransportUDP.lisp

@@ -98,4 +98,3 @@
 		(setf (ot-conn-local-address conn) localaddress)))
 	    conn)
 	(ot-error err :create)))))
-