Author: ehuelsmann
Date: Mon Jul 28 17:33:19 2008
New Revision: 397
Modified:
usocket/trunk/backend/allegro.lisp
usocket/trunk/backend/armedbear.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
Log:
Merge hans/ branch into trunk.
Modified: usocket/trunk/backend/allegro.lisp
==============================================================================
--- usocket/trunk/backend/allegro.lisp (original)
+++ usocket/trunk/backend/allegro.lisp Mon Jul 28 17:33:19 2008
@@ -49,7 +49,10 @@
:text
:binary))
-(defun socket-connect (host port &key (element-type 'character) timeout)
+(defun socket-connect (host port &key (element-type 'character) timeout nodelay)
+ (declare (ignore nodelay))
+ (when timeout
+ (warn "SOCKET-CONNECT timeout not supported in Allegro CL"))
(let ((socket))
(setf socket
(with-mapped-conditions (socket)
Modified: usocket/trunk/backend/armedbear.lisp
==============================================================================
--- usocket/trunk/backend/armedbear.lisp (original)
+++ usocket/trunk/backend/armedbear.lisp Mon Jul 28 17:33:19 2008
@@ -186,7 +186,8 @@
(typecase condition
(error (error 'unknown-error :socket socket :real-error condition))))
-(defun socket-connect (host port &key (element-type 'character) timeout)
+(defun socket-connect (host port &key (element-type 'character) timeout nodelay)
+ (declare (ignore nodelay))
(when timeout
(warn "SOCKET-CONNECT timeout not supported in ABCL"))
(let ((usock))
Modified: usocket/trunk/backend/clisp.lisp
==============================================================================
--- usocket/trunk/backend/clisp.lisp (original)
+++ usocket/trunk/backend/clisp.lisp Mon Jul 28 17:33:19 2008
@@ -55,7 +55,10 @@
(error usock-err :socket socket)
(signal usock-err :socket socket)))))))
-(defun socket-connect (host port &key (element-type 'character) timeout)
+(defun socket-connect (host port &key (element-type 'character) timeout nodelay)
+ (declare (ignore nodelay))
+ (when timeout
+ (warn "SOCKET-CONNECT timeout not supported in CLISP"))
(let ((socket)
(hostname (host-to-hostname host)))
(with-mapped-conditions (socket)
@@ -239,7 +242,7 @@
(when (wait-list usocket)
(remove-waiter (wait-list usocket) usocket))
(rawsock:sock-close (socket usocket)))
-
+
)
#-rawsock
@@ -248,4 +251,4 @@
To enable UDP socket support, please be sure to use the -Kfull parameter
at startup, or to enable RAWSOCK support during compilation.")
- )
\ No newline at end of file
+ )
Modified: usocket/trunk/backend/cmucl.lisp
==============================================================================
--- usocket/trunk/backend/cmucl.lisp (original)
+++ usocket/trunk/backend/cmucl.lisp Mon Jul 28 17:33:19 2008
@@ -50,7 +50,8 @@
:socket socket
:condition condition))))
-(defun socket-connect (host port &key (element-type 'character) timeout)
+(defun socket-connect (host port &key (element-type 'character) timeout nodelay)
+ (declare (ignore nodelay))
(when timeout
(warn "SOCKET-CONNECT timeout not supported in CMUCL"))
(let* ((socket))
Modified: usocket/trunk/backend/lispworks.lisp
==============================================================================
--- usocket/trunk/backend/lispworks.lisp (original)
+++ usocket/trunk/backend/lispworks.lisp Mon Jul 28 17:33:19 2008
@@ -73,7 +73,8 @@
(declare (ignore host port err-msg))
(raise-usock-err errno socket condition)))))
-(defun socket-connect (host port &key (element-type 'base-char) timeout)
+(defun socket-connect (host port &key (element-type 'base-char) timeout nodelay)
+ (declare (ignore nodelay))
(when timeout
(warn "SOCKET-CONNECT timeout not supported in Lispworks"))
(let ((hostname (host-to-hostname host))
Modified: usocket/trunk/backend/openmcl.lisp
==============================================================================
--- usocket/trunk/backend/openmcl.lisp (original)
+++ usocket/trunk/backend/openmcl.lisp Mon Jul 28 17:33:19 2008
@@ -61,6 +61,8 @@
(openmcl-socket:socket-error
(raise-error-from-id (openmcl-socket:socket-error-identifier condition)
socket condition))
+ (ccl:input-timeout
+ (error 'timeout-error :socket socket :real-error condition))
(ccl:communication-deadline-expired
(error 'timeout-error :socket socket :real-error condition))
(ccl::socket-creation-error #| ugh! |#
@@ -72,13 +74,14 @@
:text
:binary))
-(defun socket-connect (host port &key (element-type 'character) timeout deadline)
+(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay)
(with-mapped-conditions ()
(let ((mcl-sock
(openmcl-socket:make-socket :remote-host (host-to-hostname host)
:remote-port port
:format (to-format element-type)
:deadline deadline
+ :nodelay nodelay
:connect-timeout (and timeout
(* timeout internal-time-units-per-second)))))
(openmcl-socket:socket-connect mcl-sock)
Modified: usocket/trunk/backend/sbcl.lisp
==============================================================================
--- usocket/trunk/backend/sbcl.lisp (original)
+++ usocket/trunk/backend/sbcl.lisp Mon Jul 28 17:33:19 2008
@@ -130,7 +130,7 @@
}
@(return) = select(#3 + 1, (fd_set*)#2, NULL, NULL,
(#0 != Cnil) ? &tv : NULL);
-")))
+" :one-liner nil)))
(cond
((= 0 count)
(values nil nil))
@@ -199,7 +199,8 @@
(signal usock-cond :socket socket))))))
-(defun socket-connect (host port &key (element-type 'character) timeout deadline)
+(defun socket-connect (host port &key (element-type 'character) timeout deadline nodelay)
+ (declare (ignore nodelay))
(declare (ignore deadline))
(when timeout
(warn "SOCKET-CONNECT timeout not supported in SBCL"))
Modified: usocket/trunk/backend/scl.lisp
==============================================================================
--- usocket/trunk/backend/scl.lisp (original)
+++ usocket/trunk/backend/scl.lisp Mon Jul 28 17:33:19 2008
@@ -28,7 +28,8 @@
:socket socket
:condition condition))))
-(defun socket-connect (host port &key (element-type 'character) timeout)
+(defun socket-connect (host port &key (element-type 'character) timeout nodelay)
+ (declare (ignore nodelay))
(when timeout
(warn "SOCKET-CONNECT timeout not supported in SCL"))
(let* ((socket (with-mapped-conditions ()