[usocket-cvs] r679 - in usocket/trunk: . backend
hhubner at common-lisp.net
hhubner at common-lisp.net
Fri Jan 20 22:35:08 UTC 2012
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
More information about the usocket-cvs
mailing list