[usocket-cvs] r685 - in usocket/trunk: . backend
ctian at common-lisp.net
ctian at common-lisp.net
Sat Feb 4 15:56:01 UTC 2012
Author: ctian
Date: Sat Feb 4 07:56:00 2012
New Revision: 685
Log:
[UDP] SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer.
Modified:
usocket/trunk/CHANGES
usocket/trunk/backend/abcl.lisp
usocket/trunk/backend/allegro.lisp
usocket/trunk/backend/clisp.lisp
usocket/trunk/backend/cmucl.lisp
usocket/trunk/backend/lispworks.lisp
usocket/trunk/backend/openmcl.lisp
usocket/trunk/backend/sbcl.lisp
usocket/trunk/backend/scl.lisp
Modified: usocket/trunk/CHANGES
==============================================================================
--- usocket/trunk/CHANGES Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/CHANGES Sat Feb 4 07:56:00 2012 (r685)
@@ -1,6 +1,7 @@
0.6.0:
* New feature: SOCKET-OPTION and (setf SOCKET-OPTION) for seting and geting various socket options.
+* New feature: [UDP] SOCKET-SEND now support an CCL-like OFFSET keyword for sending only parts of the whole buffer.
* (on the way) New feature: SOCKET-SHUTDOWN for TCP and UDP sockets.
* Enhancement: SOCKET-CONNECT argument :nodelay now support :if-supported as value (patch from Anton Vodonosov).
* Enhancement: Add *remote-host* *remote-port* to SOCKET-SERVER stream handler (suggested by Matthew Curry).
Modified: usocket/trunk/backend/abcl.lisp
==============================================================================
--- usocket/trunk/backend/abcl.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/abcl.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -335,19 +335,17 @@
(code-char ub8)
ub8)))
-(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port)
+(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
(let* ((socket (socket usocket))
- (real-length (or length (length buffer)))
- (byte-array (jnew-array $*byte real-length))
+ (byte-array (jnew-array $*byte size))
(packet (if (and host port)
- (jnew $%DatagramPacket/5 byte-array 0 real-length (host-to-inet4 host) port)
- (jnew $%DatagramPacket/3 byte-array 0 real-length))))
+ (jnew $%DatagramPacket/5 byte-array 0 size (host-to-inet4 host) port)
+ (jnew $%DatagramPacket/3 byte-array 0 size))))
;; prepare sending data
- (loop for i from 0 below real-length
+ (loop for i from offset below (+ size offset)
do (setf (jarray-ref byte-array i) (*->byte (aref buffer i))))
(with-mapped-conditions (usocket)
- (jcall $@send/1 socket packet))
- real-length))
+ (jcall $@send/1 socket packet))))
;;; TODO: return-host and return-port cannot be get ...
(defmethod socket-receive ((usocket datagram-usocket) buffer length
Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/allegro.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -151,10 +151,16 @@
(values (get-peer-address usocket)
(get-peer-port usocket)))
-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
+(defmethod socket-send ((socket datagram-usocket) buffer size &key host port (offset 0))
(with-mapped-conditions (socket)
(let ((s (socket socket)))
- (socket:send-to s buffer length :remote-host host :remote-port port))))
+ (socket:send-to s
+ (if (zerop offset)
+ buffer
+ (subseq buffer offset (+ offset size)))
+ size
+ :remote-host host
+ :remote-port port))))
(defmethod socket-receive ((socket datagram-usocket) buffer length &key)
(declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/clisp.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -93,10 +93,12 @@
"Dispatch correct usocket condition."
(let (error-keyword error-string)
(typecase condition
+ #+ffi ; because OS:ERRNO and OS:STRERROR is only present if FFI is present.
(system::simple-os-error
(let ((errno (car (simple-condition-format-arguments condition))))
(setq error-keyword (os:errno errno)
error-string (os:strerror errno))))
+ #+ffi ; because OS:ERRNO and OS:STRERROR is only present if FFI is present.
(simple-error
(let ((keyword
(car (simple-condition-format-arguments condition))))
@@ -302,7 +304,7 @@
host
port))))
- (defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
+ (defmethod socket-send ((socket datagram-usocket) buffer size &key host port (offset 0))
"Returns the number of octets sent."
(let* ((sock (socket socket))
(sockaddr (when (and host port)
@@ -311,19 +313,19 @@
(make-sockaddr_in)
(host-byte-order host)
port))))
- (real-length (or length (length buffer)))
+ (real-size (min size +max-datagram-packet-size+))
(real-buffer (if (typep buffer '(simple-array (unsigned-byte 8) (*)))
buffer
- (make-array real-length
+ (make-array real-size
:element-type '(unsigned-byte 8)
- :initial-contents (subseq buffer 0 real-length))))
+ :initial-contents (subseq buffer 0 real-size))))
(rv (if (and host port)
(rawsock:sendto sock real-buffer sockaddr
- :start 0
- :end real-length)
+ :start offset
+ :end (+ offset real-size))
(rawsock:send sock real-buffer
- :start 0
- :end real-length))))
+ :start offset
+ :end (+ offset real-size)))))
rv))
(defmethod socket-close ((usocket datagram-usocket))
@@ -631,30 +633,31 @@
;; in LispWorks. So, we allocate new foreign buffer for holding data (unknown sequence subtype) every time.
;;
;; I don't know if anyone is watching my coding work, but I think this design is reasonable for CLISP.
- (defmethod socket-send ((usocket datagram-usocket) buffer length &key host port)
+ (defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
(declare (type sequence buffer)
- (type integer length))
- (let ((remote-address (when (and host port)
- (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in) host port)))
- (send-buffer (let ((buffer-length (length buffer)))
- (if (> buffer-length (* length 2))
- ;; if buffer is too big, then we copy out a subseq and only allocate as need
- (ffi:allocate-deep 'ffi:uint8 (subseq buffer 0 length) :count length :read-only t)
- ;; then we allocate the whole buffer directly, that should be faster.
- (ffi:allocate-deep 'ffi:uint8 buffer :count (length buffer) :read-only t))))
- (real-length (min length +max-datagram-packet-size+))
+ (type (integer 0 *) size offset))
+ (let ((remote-address
+ (when (and host port)
+ (fill-sockaddr_in (ffi:allocate-shallow 'sockaddr_in) host port)))
+ (send-buffer
+ (ffi:allocate-deep 'ffi:uint8
+ (if (zerop offset)
+ buffer
+ (subseq buffer offset (+ offset size)))
+ :count size :read-only t))
+ (real-size (min size +max-datagram-packet-size+))
(nbytes 0))
(unwind-protect
(let ((n (if remote-address
(%sendto (socket usocket)
(ffi:foreign-address send-buffer)
- real-length
+ real-size
0 ; flags
(ffi:cast (ffi:foreign-value remote-address) 'sockaddr)
*length-of-sockaddr_in*)
(%send (socket usocket)
(ffi:foreign-address send-buffer)
- real-length
+ real-size
0))))
(cond ((plusp n)
(setq nbytes n))
Modified: usocket/trunk/backend/cmucl.lisp
==============================================================================
--- usocket/trunk/backend/cmucl.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/cmucl.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -174,14 +174,17 @@
length
flags))
-(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port)
+(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)
+ &aux (real-buffer (if (zerop offset)
+ buffer
+ (subseq buffer offset (+ offset size)))))
(with-mapped-conditions (usocket)
(if (and host port)
- (ext:inet-sendto (socket usocket) buffer length (host-to-hbo host) port)
+ (ext:inet-sendto (socket usocket) real-buffer size (host-to-hbo host) port)
#-unicode
- (unix:unix-send (socket usocket) buffer length 0)
+ (unix:unix-send (socket usocket) real-buffer size 0)
#+unicode
- (%unix-send (socket usocket) buffer length 0))))
+ (%unix-send (socket usocket) real-buffer size 0))))
(defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
(declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/lispworks.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -423,28 +423,27 @@
(defvar *length-of-sockaddr_in*
(fli:size-of '(:struct comm::sockaddr_in)))
-(defun send-message (socket-fd message buffer &optional (length (length buffer)) host service)
+(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0)
+ &aux (socket-fd (socket usocket))
+ (message (slot-value usocket 'send-buffer)))
"Send message to a socket, using sendto()/send()"
(declare (type integer socket-fd)
(type sequence buffer))
+ (when host (setq host (host-to-hbo host)))
(fli:with-dynamic-lisp-array-pointer (ptr message :type '(:unsigned :byte))
- (replace message buffer :end2 length)
- (if (and host service)
+ (replace message buffer :start2 offset :end2 (+ offset size))
+ (if (and host port)
(fli:with-dynamic-foreign-objects ()
(multiple-value-bind (error family client-addr client-addr-length)
- (initialize-dynamic-sockaddr host service "udp")
+ (initialize-dynamic-sockaddr host port "udp")
+ (declare (ignore family))
(when error
- (error "cannot resolve hostname ~S, service ~S: ~A"
- host service error))
- (%sendto socket-fd ptr (min length +max-datagram-packet-size+) 0
+ (error "cannot resolve hostname ~S, port ~S: ~A"
+ host port error))
+ (%sendto socket-fd ptr (min size +max-datagram-packet-size+) 0
(fli:copy-pointer client-addr :type '(:struct comm::sockaddr))
client-addr-length)))
- (comm::%send socket-fd ptr (min length +max-datagram-packet-size+) 0))))
-
-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
- (send-message (socket socket)
- (slot-value socket 'send-buffer)
- buffer length (and host (host-to-hbo host)) port))
+ (comm::%send socket-fd ptr (min size +max-datagram-packet-size+) 0))))
(defun receive-message (socket-fd message &optional buffer (length (length buffer))
&key read-timeout (max-buffer-size +max-datagram-packet-size+))
Modified: usocket/trunk/backend/openmcl.lisp
==============================================================================
--- usocket/trunk/backend/openmcl.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/openmcl.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -149,24 +149,25 @@
(with-mapped-conditions (usocket)
(close (socket usocket))))
-(defmethod socket-send ((usocket datagram-usocket) buffer length &key host port offset)
+(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
(with-mapped-conditions (usocket)
(if (and host port)
- (openmcl-socket:send-to (socket usocket) buffer length
+ (openmcl-socket:send-to (socket usocket) buffer size
:remote-host (host-to-hbo host)
- :remote-port port)
+ :remote-port port
+ :offset offset)
;; Clozure CL's socket function SEND-TO doesn't support operations on connected UDP sockets,
;; so we have to define our own.
(let* ((socket (socket usocket))
(fd (ccl::socket-device socket)))
(multiple-value-setq (buffer offset)
- (ccl::verify-socket-buffer buffer offset length))
- (ccl::%stack-block ((bufptr length))
- (ccl::%copy-ivector-to-ptr buffer offset bufptr 0 length)
+ (ccl::verify-socket-buffer buffer offset size))
+ (ccl::%stack-block ((bufptr size))
+ (ccl::%copy-ivector-to-ptr buffer offset bufptr 0 size)
(ccl::socket-call socket "send"
(ccl::with-eagain fd :output
(ccl::ignoring-eintr
- (ccl::check-socket-error (#_send fd bufptr length 0))))))))))
+ (ccl::check-socket-error (#_send fd bufptr size 0))))))))))
(defmethod socket-receive ((usocket datagram-usocket) buffer length &key)
(with-mapped-conditions (usocket)
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/sbcl.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -398,11 +398,14 @@
(with-mapped-conditions (usocket)
(close (socket-stream usocket))))
-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
+(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port (offset 0))
(with-mapped-conditions (socket)
- (let* ((s (socket socket))
- (dest (if (and host port) (list (host-to-vector-quad host) port) nil)))
- (sb-bsd-sockets:socket-send s buffer length :address dest))))
+ (let* ((s (socket usocket))
+ (dest (if (and host port) (list (host-to-vector-quad host) port) nil))
+ (real-buffer (if (zerop offset)
+ buffer
+ (subseq buffer offset (+ offset size)))))
+ (sb-bsd-sockets:socket-send s real-buffer size :address dest))))
(defmethod socket-receive ((socket datagram-usocket) buffer length
&key (element-type '(unsigned-byte 8)))
Modified: usocket/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp Sat Feb 4 02:35:44 2012 (r684)
+++ usocket/trunk/backend/scl.lisp Sat Feb 4 07:56:00 2012 (r685)
@@ -136,14 +136,17 @@
(defmethod socket-close :after ((socket datagram-usocket))
(setf (%open-p socket) nil))
-(defmethod socket-send ((socket datagram-usocket) buffer length &key host port)
- (let ((s (socket socket))
- (host (if host (host-to-hbo host))))
+(defmethod socket-send ((usocket datagram-usocket) buffer size &key host port)
+ (let ((s (socket usocket))
+ (host (if host (host-to-hbo host)))
+ (real-buffer (if (zerop offset)
+ buffer
+ (subseq buffer offset (+ offset size)))))
(multiple-value-bind (result errno)
- (ext:inet-socket-send-to s buffer length
+ (ext:inet-socket-send-to s real-buffer size
:remote-host host :remote-port port)
(or result
- (scl-map-socket-error errno :socket socket)))))
+ (scl-map-socket-error errno :socket usocket)))))
(defmethod socket-receive ((socket datagram-usocket) buffer length &key)
(declare (values (simple-array (unsigned-byte 8) (*)) ; buffer
More information about the usocket-cvs
mailing list