[MCL] initial UDP support for SOCKET-CONNECT.

CHANGES

@@ -1,3 +1,8 @@
+0.6.1:
+
+* New feature: Added initial MOCL support (TCP only, no W-F-I, patch from github.com/Wukix/usocket).
+* New feature: UDP support for Macintosh Common Lisp (MCL).
+
 0.6.0:
 
 * New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options.
@@ -67,5 +72,4 @@
 [TODO]
 
 * New feature: CLISP support some advanced TCP features which CLISP's SOCKET interface not provide
-* New feature: Macintosh Common Lisp (MCL) support Datagram sockets (UDP)
 * New feature: SOCKET-SHUTDOWN for TCP and UDP sockets.

README

@@ -29,6 +29,7 @@ The library currently supports:
  - ECL
  - Scieneer Common Lisp
  - Macintosh Common Lisp
+ - MOCL
 
 If your favorite common lisp misses in the list above, please contact
 [email protected] and submit a request.  Please include

backend/mcl.lisp

@@ -30,21 +30,25 @@
                             local-host local-port (protocol :stream))
   (when (eq nodelay :if-supported)
     (setf nodelay t))
-  (when (eq protocol :datagram)
-    (unsupported '(protocol :datagram) 'socket-connect))
   (with-mapped-conditions ()
-    (let* ((socket
-            (make-instance 'active-socket
-              :remote-host (when host (host-to-hostname host)) 
-              :remote-port port
-              :local-host (when local-host (host-to-hostname local-host)) 
-              :local-port local-port
-              :deadline deadline
-              :nodelay nodelay
-              :connect-timeout (and timeout (round (* timeout 60)))
-              :element-type element-type))
-           (stream (socket-open-stream socket)))
-      (make-stream-socket :socket socket :stream stream))))
+    (ecase protocol
+      (:stream
+       (let* ((socket
+               (make-instance 'active-socket
+                 :remote-host (when host (host-to-hostname host)) 
+                 :remote-port port
+                 :local-host (when local-host (host-to-hostname local-host)) 
+                 :local-port local-port
+                 :deadline deadline
+                 :nodelay nodelay
+                 :connect-timeout (and timeout (round (* timeout 60)))
+                 :element-type element-type))
+              (stream (socket-open-stream socket)))
+         (make-stream-socket :socket socket :stream stream)))
+      (:datagram
+       (make-datagram-socket
+         (ccl::open-udp-socket :local-address (and local-host (host-to-hostname local-host))
+			       :local-port local-port))))))
 
 (defun socket-listen (host port
                            &key reuseaddress

option.lisp

@@ -63,6 +63,8 @@
     (get-socket-receive-timeout socket)
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+sbcl
     (sb-impl::fd-stream-timeout (socket-stream usocket))
     #+scl
@@ -91,6 +93,8 @@
     (set-socket-receive-timeout socket timeout)
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+sbcl
     (setf (sb-impl::fd-stream-timeout (socket-stream usocket))
           (coerce timeout 'single-float))
@@ -119,6 +123,8 @@
     (get-socket-reuse-address socket)
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+(or ecl sbcl)
     (sb-bsd-sockets:sockopt-reuse-address socket)
     #+scl
@@ -143,6 +149,8 @@
     (set-socket-reuse-address socket new-value)
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+(or ecl sbcl)
     (setf (sb-bsd-sockets:sockopt-reuse-address socket) new-value)
     #+scl
@@ -172,6 +180,8 @@
     () ; TODO
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+sbcl
     (sb-bsd-sockets:sockopt-broadcast socket)
     #+scl
@@ -198,6 +208,8 @@
     () ; TODO
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+sbcl
     (setf (sb-bsd-sockets:sockopt-broadcast socket) new-value)
     #+scl
@@ -227,6 +239,8 @@
     () ; TODO
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+sbcl
     (sb-bsd-sockets::sockopt-tcp-nodelay socket)
     #+scl
@@ -253,6 +267,8 @@
     (comm::set-socket-tcp-nodelay socket new-value)
     #+mcl
     () ; TODO
+    #+mocl
+    () ; unknown
     #+sbcl
     (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) new-value)
     #+scl

usocket.asd

@@ -8,7 +8,7 @@
     :name "usocket"
     :author "Erik Enge & Erik Huelsmann"
     :maintainer "Chun Tian (binghe)"
-    :version "0.6.0"
+    :version "0.6.1"
     :licence "MIT"
     :description "Universal socket library for Common Lisp"
     :depends-on (#+(or sbcl ecl) :sb-bsd-sockets)
@@ -25,7 +25,7 @@
 			       #+clisp		(:file "clisp")
 			       #+cmu		(:file "cmucl")
 			       #+scl		(:file "scl")
-			       #+ecl	(:file "ecl")
+			       #+ecl		(:file "ecl")
 			       #+(or sbcl ecl)	(:file "sbcl"
 						 :depends-on (#+ecl "ecl"))
 			       #+lispworks	(:file "lispworks")

vendor/OpenTransportUDP.lisp

@@ -49,3 +49,16 @@
 	  result)
 	(:do-it)))
   :when :around :name 'ot-conn-tcp-passive-connect-any-address)
+
+(defun open-udp-socket (&key local-address local-port)
+  (init-opentransport)
+  (let (endpoint
+	(err #$kOTNoError)
+	(configptr (ot-cloned-configuration traps::$kUDPName)))
+    (rlet ((errP :osstatus))
+      (setq endpoint #+carbon-compat (#_OTOpenEndpointInContext configptr 0 (%null-ptr) errP *null-ptr*)
+	             #-carbon-compat (#_OTOpenEndpoint configptr 0 (%null-ptr) errP)
+	    err (pref errP :osstatus))
+      (unless (eql err #$kOTNoError)
+	(ot-error err :create))
+      endpoint)))