[usocket-cvs] r538 - in usocket/trunk: . backend vendor

[Chun Tian (binghe)]

Author: ctian
Date: Fri Jul  9 04:38:33 2010
New Revision: 538

Log:
CCL: add support for SOCKET-SEND on connected usocket.

Added:
   usocket/trunk/vendor/ccl-send.lisp   (contents, props changed)
Modified:
   usocket/trunk/backend/openmcl.lisp
   usocket/trunk/usocket.asd

Modified: usocket/trunk/backend/openmcl.lisp
==============================================================================
--- usocket/trunk/backend/openmcl.lisp	(original)
+++ usocket/trunk/backend/openmcl.lisp	Fri Jul  9 04:38:33 2010
@@ -144,12 +144,14 @@
   (with-mapped-conditions (usocket)
     (close (socket usocket))))
 
-;;; TODO: use send() if already connected.
 (defmethod socket-send ((usocket datagram-usocket) buffer length &key host port)
   (with-mapped-conditions (usocket)
-    (openmcl-socket:send-to (socket usocket) buffer length
-			    :remote-host (if host (host-to-hbo host))
-			    :remote-port port)))
+    (if (and host port)
+	(openmcl-socket:send-to (socket usocket) buffer length
+				:remote-host (host-to-hbo host)
+				:remote-port port)
+	;; following functino was defined in "vendor/ccl-send.lisp"
+	(ccl::send-for-usocket (socket usocket) buffer length))))
 
 (defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
   (with-mapped-conditions (usocket)

Modified: usocket/trunk/usocket.asd
==============================================================================
--- usocket/trunk/usocket.asd	(original)
+++ usocket/trunk/usocket.asd	Fri Jul  9 04:38:33 2010
@@ -21,7 +21,8 @@
     :components ((:file "package")
 		 (:module "vendor" :depends-on ("package")
 		  :components ((:file "split-sequence")
-			       #+mcl (:file "kqueue")))
+			       #+mcl (:file "kqueue")
+			       #+clozure (:file "ccl-send")))
                  (:file "usocket" :depends-on ("vendor"))
                  (:file "condition" :depends-on ("usocket"))
 		 (:module "backend" :depends-on ("condition")

Added: usocket/trunk/vendor/ccl-send.lisp
==============================================================================
--- (empty file)
+++ usocket/trunk/vendor/ccl-send.lisp	Fri Jul  9 04:38:33 2010
@@ -0,0 +1,19 @@
+;;;; -*- Mode: Lisp -*-
+;;;; $Id$
+
+;;;; Clozure CL's socket function SEND-TO doesn't support operations on connected UDP sockets.
+
+(in-package :ccl)
+
+(defun c_send-for-usocket (sockfd msgptr len flags)
+  (ignoring-eintr (check-socket-error (#_send sockfd msgptr len flags))))
+
+(defun send-for-usocket (socket msg size &key offset)
+  "Send a UDP packet over a connected socket."
+  (let ((fd (socket-device socket)))
+    (multiple-value-setq (msg offset) (verify-socket-buffer msg offset size))
+    (%stack-block ((bufptr size))
+      (%copy-ivector-to-ptr msg offset bufptr 0 size)
+      (socket-call socket "send"
+	(with-eagain fd :output
+	  (c_send-for-usocket fd bufptr size 0))))))