Author: hhubner Date: Fri Jan 20 14:35:07 2012 New Revision: 679

Log: :nodelay :if-supported patch from Anton Vodonosov

Modified: 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/mcl.lisp usocket/trunk/backend/openmcl.lisp usocket/trunk/backend/sbcl.lisp usocket/trunk/backend/scl.lisp usocket/trunk/usocket.lisp

Modified: usocket/trunk/backend/abcl.lisp ============================================================================== --- usocket/trunk/backend/abcl.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/abcl.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -212,7 +212,8 @@ (setq stream (ext:get-socket-stream socket :element-type element-type) usocket (make-stream-socket :stream stream :socket socket)) (when nodelay-supplied-p - (jcall $@setTcpNoDelay/1 socket (if nodelay +java-true+ +java-false+))) + (jcall $@setTcpNoDelay/1 socket (if nodelay ;; both t and :if-supported mean +java-true+ + +java-true+ +java-false+))) (when timeout (jcall $@setSoTimeout/Socket/1 socket (truncate (* 1000 timeout)))))) (:datagram ; UDP

Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/allegro.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -55,6 +55,8 @@ local-host local-port) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) + (when (eq nodelay :if-supported) + (setf nodelay t))

(let ((socket)) (setf socket

Modified: usocket/trunk/backend/clisp.lisp ============================================================================== --- usocket/trunk/backend/clisp.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/clisp.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -116,10 +116,11 @@ (defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline (nodelay t nodelay-specified) local-host local-port) - (declare (ignore nodelay) - (ignorable timeout local-host local-port)) + (declare (ignorable timeout local-host local-port)) (when deadline (unsupported 'deadline 'socket-connect)) - (when nodelay-specified (unsupported 'nodelay 'socket-connect)) + (when (and nodelay-specified + (not (eq nodelay :if-supported))) + (unsupported 'nodelay 'socket-connect)) (case protocol (:stream (let ((socket)

Modified: usocket/trunk/backend/cmucl.lisp ============================================================================== --- usocket/trunk/backend/cmucl.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/cmucl.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -56,10 +56,11 @@ (local-port nil local-port-p) &aux (local-bind-p (fboundp 'ext::bind-inet-socket))) - (declare (ignore nodelay)) (when timeout (unsupported 'timeout 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) - (when nodelay-specified (unsupported 'nodelay 'socket-connect)) + (when (and nodelay-specified + (not (eq nodelay :if-supported))) + (unsupported 'nodelay 'socket-connect)) (when (and local-host-p (not local-bind-p)) (unsupported 'local-host 'socket-connect :minimum "Snapshot 2008-08 (19E)")) (when (and local-port-p (not local-bind-p))

Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/lispworks.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -253,7 +253,6 @@ (defun socket-connect (host port &key (protocol :stream) (element-type 'base-char) timeout deadline (nodelay t nodelay-specified) local-host (local-port #+win32 *auto-port* #-win32 nil)) - (declare (ignorable nodelay))

;; What's the meaning of this keyword? (when deadline @@ -264,7 +263,8 @@ (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5"))

#+(or lispworks4 lispworks5.0) ; < 5.1 - (when nodelay-specified + (when (and nodelay-specified + (not (eq nodelay :if-supported))) (unsupported 'nodelay 'socket-connect :minimum "LispWorks 5.1"))

#+lispworks4 #+lispworks4

Modified: usocket/trunk/backend/mcl.lisp ============================================================================== --- usocket/trunk/backend/mcl.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/mcl.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -73,6 +73,8 @@

(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay 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 ()

Modified: usocket/trunk/backend/openmcl.lisp ============================================================================== --- usocket/trunk/backend/openmcl.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/openmcl.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -85,6 +85,8 @@ (defun socket-connect (host port &key (protocol :stream) (element-type 'character) timeout deadline nodelay local-host local-port) + (when (eq nodelay :if-supported) + (setf nodelay t)) (with-mapped-conditions () (ecase protocol (:stream

Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/sbcl.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -261,8 +261,11 @@ ;; package today. There's no guarantee the functions ;; we need are available, but we can make sure not to ;; call them if they aren't + (not (eq nodelay :if-supported)) (not sockopt-tcp-nodelay-p)) (unsupported 'nodelay 'socket-connect)) + (when (eq nodelay :if-supported) + (setf nodelay t))

(let ((socket (make-instance 'sb-bsd-sockets:inet-socket :type protocol

Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/backend/scl.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -34,8 +34,9 @@ (local-port nil local-port-p) &aux (patch-udp-p (fboundp 'ext::inet-socket-send-to))) - (declare (ignore nodelay)) - (when nodelay-specified (unsupported 'nodelay 'socket-connect)) + (when (and nodelay-specified + (not (eq nodelay :if-supported))) + (unsupported 'nodelay 'socket-connect)) (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and local-host-p (not patch-udp-p))

Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp Thu Nov 10 17:40:53 2011 (r678) +++ usocket/trunk/usocket.lisp Fri Jan 20 14:35:07 2012 (r679) @@ -529,7 +529,7 @@

;; Documentation for the function ;; -;; (defun SOCKET-CONNECT (host port &key element-type) ..) +;; (defun SOCKET-CONNECT (host port &key element-type nodelay some-other-keys...) ..) ;; (setf (documentation 'socket-connect 'function) "Connect to `host' on `port'. `host' is assumed to be a string or @@ -539,6 +539,20 @@ `element-type' specifies the element type to use when constructing the stream associated with the socket. The default is 'character.

+`nodelay' Allows to disable/enable Nagle's algorithm (http://en.wikipedia.org/wiki/Nagle%27s_algorithm). +If this parameter is omitted, the behaviour is inherited form the +CL implementation (in most cases the Nagle's algorithm is +enabled by default, but for example in ACL it is disabled). +If the parmeter is specified, one of these three values is possible: + T - Disable the Nagle's algorithm; signals an UNSUPPORTED + condition if the implementation does not support explicit + manipulation with that option. + NIL - Leave the Nagle's algorithm enabled on the socket; + signals an UNSUPPORTED condition if the implementation does + not support explicit manipulation with that option. + :IF-SUPPORTED - Disables the Nagle's algorithm if the implementation + allows this, otherwises just ignore this option. + Returns a usocket object.")

;; Documentation for the function