From ctian at common-lisp.net Wed Nov 12 13:37:45 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 12 Nov 2008 13:37:45 +0000 Subject: [usocket-cvs] r473 - usocket/trunk/backend Message-ID: Author: ctian Date: Wed Nov 12 13:37:41 2008 New Revision: 473 Log: [usocket] update SOCKET-CONNECT on LW, TIMEOUT is supported. Modified: usocket/trunk/backend/lispworks.lisp Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Wed Nov 12 13:37:41 2008 @@ -93,11 +93,19 @@ timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignorable nodelay)) - (when timeout (unimplemented 'timeout 'socket-connect)) - (when deadline (unsupported 'deadline 'socket-connect :minimum "LispWorks 5.1")) + + ;; What's the meaning of this keyword? + (when deadline + (unimplemented 'deadline 'socket-connect)) - #+(and (not lispworks4) (not lispworks5.0)) - (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) + #+(or lispworks4.2 lispworks4.3) ; < 4.4.5 + (when timeout + (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5")) + + #+(or lispworks4 lispworks5.0) ; < 5.1 + (when nodelay-specified + (unsupported 'nodelay 'socket-connect :minimum "LispWorks 5.1")) + #+lispworks4 #+lispworks4 (when local-host (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0")) @@ -110,12 +118,15 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type + #-(or lispworks4.2 lispworks4.3) ; >= 4.4.5 + #-(or lispworks4.2 lispworks4.3) + :timeout timeout #-lispworks4 #-lispworks4 #-lispworks4 #-lispworks4 :local-address (when local-host (host-to-hostname local-host)) :local-port local-port - #+(and (not lispworks4) (not lispworks5.0)) - #+(and (not lispworks4) (not lispworks5.0)) + #-(or lispworks4 lispworks5.0) ; >= 5.1 + #-(or lispworks4 lispworks5.0) :nodelay nodelay))) (if stream (make-stream-socket :socket (comm:socket-stream-socket stream) From ctian at common-lisp.net Wed Nov 12 13:39:02 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 12 Nov 2008 13:39:02 +0000 Subject: [usocket-cvs] r474 - usocket/branches/experimental-udp/backend Message-ID: Author: ctian Date: Wed Nov 12 13:39:02 2008 New Revision: 474 Log: [udp-branch] update SOCKET-CONNECT on LW, TIMEOUT is supported. Modified: usocket/branches/experimental-udp/backend/lispworks.lisp Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Wed Nov 12 13:39:02 2008 @@ -250,11 +250,19 @@ timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignorable nodelay)) - (when timeout (unimplemented 'timeout 'socket-connect)) - (when deadline (unsupported 'deadline 'socket-connect :minimum "LispWorks 5.1")) - - #+(and (not lispworks4) (not lispworks5.0)) - (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) + + ;; What's the meaning of this keyword? + (when deadline + (unimplemented 'deadline 'socket-connect)) + + #+(or lispworks4.2 lispworks4.3) ; < 4.4.5 + (when timeout + (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5")) + + #+(or lispworks4 lispworks5.0) ; < 5.1 + (when nodelay-specified + (unsupported 'nodelay 'socket-connect :minimum "LispWorks 5.1")) + #+lispworks4 #+lispworks4 (when local-host (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0")) @@ -269,12 +277,15 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type + #-(or lispworks4.2 lispworks4.3) ; >= 4.4.5 + #-(or lispworks4.2 lispworks4.3) + :timeout timeout #-lispworks4 #-lispworks4 #-lispworks4 #-lispworks4 :local-address (when local-host (host-to-hostname local-host)) :local-port local-port - #+(and (not lispworks4) (not lispworks5.0)) - #+(and (not lispworks4) (not lispworks5.0)) + #-(or lispworks4 lispworks5.0) ; >= 5.1 + #-(or lispworks4 lispworks5.0) :nodelay nodelay))) (if stream (make-stream-socket :socket (comm:socket-stream-socket stream) From ctian at common-lisp.net Wed Nov 12 13:39:51 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 12 Nov 2008 13:39:51 +0000 Subject: [usocket-cvs] r475 - usocket/branches/0.4.x/backend Message-ID: Author: ctian Date: Wed Nov 12 13:39:46 2008 New Revision: 475 Log: [0.4.x] update SOCKET-CONNECT on LW, TIMEOUT is supported. Modified: usocket/branches/0.4.x/backend/lispworks.lisp Modified: usocket/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Wed Nov 12 13:39:46 2008 @@ -93,11 +93,19 @@ timeout deadline (nodelay t nodelay-specified) local-host local-port) (declare (ignorable nodelay)) - (when timeout (unimplemented 'timeout 'socket-connect)) - (when deadline (unsupported 'deadline 'socket-connect :minimum "LispWorks 5.1")) + + ;; What's the meaning of this keyword? + (when deadline + (unimplemented 'deadline 'socket-connect)) + + #+(or lispworks4.2 lispworks4.3) ; < 4.4.5 + (when timeout + (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5")) - #+(and (not lispworks4) (not lispworks5.0)) - (when nodelay-specified (unimplemented 'nodelay 'socket-connect)) + #+(or lispworks4 lispworks5.0) ; < 5.1 + (when nodelay-specified + (unsupported 'nodelay 'socket-connect :minimum "LispWorks 5.1")) + #+lispworks4 #+lispworks4 (when local-host (unsupported 'local-host 'socket-connect :minimum "LispWorks 5.0")) @@ -110,12 +118,15 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type + #-(or lispworks4.2 lispworks4.3) ; >= 4.4.5 + #-(or lispworks4.2 lispworks4.3) + :timeout timeout #-lispworks4 #-lispworks4 #-lispworks4 #-lispworks4 :local-address (when local-host (host-to-hostname local-host)) :local-port local-port - #+(and (not lispworks4) (not lispworks5.0)) - #+(and (not lispworks4) (not lispworks5.0)) + #-(or lispworks4 lispworks5.0) ; >= 5.1 + #-(or lispworks4 lispworks5.0) :nodelay nodelay))) (if stream (make-stream-socket :socket (comm:socket-stream-socket stream) From ctian at common-lisp.net Wed Nov 12 14:18:15 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 12 Nov 2008 14:18:15 +0000 Subject: [usocket-cvs] r476 - in usocket: branches/0.4.x/backend branches/experimental-udp/backend trunk/backend Message-ID: Author: ctian Date: Wed Nov 12 14:18:15 2008 New Revision: 476 Log: [bugfix] read macro fix for detect on version before 4.4.5 Modified: usocket/branches/0.4.x/backend/lispworks.lisp usocket/branches/experimental-udp/backend/lispworks.lisp usocket/trunk/backend/lispworks.lisp Modified: usocket/branches/0.4.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.4.x/backend/lispworks.lisp (original) +++ usocket/branches/0.4.x/backend/lispworks.lisp Wed Nov 12 14:18:15 2008 @@ -98,7 +98,7 @@ (when deadline (unimplemented 'deadline 'socket-connect)) - #+(or lispworks4.2 lispworks4.3) ; < 4.4.5 + #+(and lispworks4 (not lispworks4.4)) ; < 4.4.5 (when timeout (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5")) @@ -118,8 +118,8 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type - #-(or lispworks4.2 lispworks4.3) ; >= 4.4.5 - #-(or lispworks4.2 lispworks4.3) + #-(and lispworks4 (not lispworks4.4)) ; >= 4.4.5 + #-(and lispworks4 (not lispworks4.4)) :timeout timeout #-lispworks4 #-lispworks4 #-lispworks4 #-lispworks4 Modified: usocket/branches/experimental-udp/backend/lispworks.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/lispworks.lisp (original) +++ usocket/branches/experimental-udp/backend/lispworks.lisp Wed Nov 12 14:18:15 2008 @@ -255,7 +255,7 @@ (when deadline (unimplemented 'deadline 'socket-connect)) - #+(or lispworks4.2 lispworks4.3) ; < 4.4.5 + #+(and lispworks4 (not lispworks4.4)) ; < 4.4.5 (when timeout (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5")) @@ -277,8 +277,8 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type - #-(or lispworks4.2 lispworks4.3) ; >= 4.4.5 - #-(or lispworks4.2 lispworks4.3) + #-(and lispworks4 (not lispworks4.4)) ; >= 4.4.5 + #-(and lispworks4 (not lispworks4.4)) :timeout timeout #-lispworks4 #-lispworks4 #-lispworks4 #-lispworks4 Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp (original) +++ usocket/trunk/backend/lispworks.lisp Wed Nov 12 14:18:15 2008 @@ -98,7 +98,7 @@ (when deadline (unimplemented 'deadline 'socket-connect)) - #+(or lispworks4.2 lispworks4.3) ; < 4.4.5 + #+(and lispworks4 (not lispworks4.4)) ; < 4.4.5 (when timeout (unsupported 'timeout 'socket-connect :minimum "LispWorks 4.4.5")) @@ -118,8 +118,8 @@ (with-mapped-conditions () (comm:open-tcp-stream hostname port :element-type element-type - #-(or lispworks4.2 lispworks4.3) ; >= 4.4.5 - #-(or lispworks4.2 lispworks4.3) + #-(and lispworks4 (not lispworks4.4)) ; >= 4.4.5 + #-(and lispworks4 (not lispworks4.4)) :timeout timeout #-lispworks4 #-lispworks4 #-lispworks4 #-lispworks4 From ctian at common-lisp.net Fri Nov 14 15:51:32 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Fri, 14 Nov 2008 15:51:32 +0000 Subject: [usocket-cvs] r477 - usocket/branches/experimental-udp Message-ID: Author: ctian Date: Fri Nov 14 15:51:32 2008 New Revision: 477 Log: [udp] bugfix for SCL, make sure server thread can exit when (QUIT) called, otherwise SCL will hang. Modified: usocket/branches/experimental-udp/server.lisp Modified: usocket/branches/experimental-udp/server.lisp ============================================================================== --- usocket/branches/experimental-udp/server.lisp (original) +++ usocket/branches/experimental-udp/server.lisp Fri Nov 14 15:51:32 2008 @@ -38,5 +38,8 @@ (when (minusp n) (error "send error: ~A~%" n)))))) (error "receive error: ~A" n)))) + #+scl (when thread:*quitting-lisp* + (return)) #+(and cmu mp) (mp:process-yield)))) - (socket-close socket)))) + (socket-close socket) + (values)))) From ctian at common-lisp.net Mon Nov 17 12:10:31 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Mon, 17 Nov 2008 12:10:31 +0000 Subject: [usocket-cvs] r478 - in usocket: branches/0.4.x/backend branches/experimental-udp/backend trunk/backend Message-ID: Author: ctian Date: Mon Nov 17 12:10:30 2008 New Revision: 478 Log: [bugfix] fix compilation on old ECL which has no sb-bsd-sockets:sockopt-tcp-nodelay defined. Modified: usocket/branches/0.4.x/backend/sbcl.lisp usocket/branches/experimental-udp/backend/sbcl.lisp usocket/trunk/backend/sbcl.lisp Modified: usocket/branches/0.4.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/sbcl.lisp (original) +++ usocket/branches/0.4.x/backend/sbcl.lisp Mon Nov 17 12:10:30 2008 @@ -229,8 +229,10 @@ ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket)) (ip (host-to-vector-quad host))) + ;; binghe: use SOCKOPT-TCP-NODELAY as internal symbol + ;; to pass compilation on ECL without it. (when (and nodelay-specified sockopt-tcp-nodelay-p) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) nodelay)) (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket (host-to-vector-quad Modified: usocket/branches/experimental-udp/backend/sbcl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/sbcl.lisp (original) +++ usocket/branches/experimental-udp/backend/sbcl.lisp Mon Nov 17 12:10:30 2008 @@ -231,8 +231,10 @@ ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket)) (ip (host-to-vector-quad host))) + ;; binghe: use SOCKOPT-TCP-NODELAY as internal symbol + ;; to pass compilation on ECL without it. (when (and nodelay-specified sockopt-tcp-nodelay-p) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) nodelay)) (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket (host-to-vector-quad Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp (original) +++ usocket/trunk/backend/sbcl.lisp Mon Nov 17 12:10:30 2008 @@ -229,8 +229,10 @@ ;;###FIXME: The above line probably needs an :external-format (usocket (make-stream-socket :stream stream :socket socket)) (ip (host-to-vector-quad host))) - (when (and nodelay-specified sockopt-tcp-nodelay-p) - (setf (sb-bsd-sockets:sockopt-tcp-nodelay socket) nodelay)) + ;; binghe: use SOCKOPT-TCP-NODELAY as internal symbol + ;; to pass compilation on ECL without it. + (when (and nodelay-specified sockopt-tcp-nodelay-p) + (setf (sb-bsd-sockets::sockopt-tcp-nodelay socket) nodelay)) (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket (host-to-vector-quad From ctian at common-lisp.net Wed Nov 26 16:18:11 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 26 Nov 2008 16:18:11 +0000 Subject: [usocket-cvs] r479 - in usocket: branches/0.4.x/backend branches/experimental-udp/backend trunk/backend Message-ID: Author: ctian Date: Wed Nov 26 16:18:06 2008 New Revision: 479 Log: [scl] update version requirements for SCL (1.3.9 already released) Modified: usocket/branches/0.4.x/backend/scl.lisp usocket/branches/experimental-udp/backend/scl.lisp usocket/trunk/backend/scl.lisp Modified: usocket/branches/0.4.x/backend/scl.lisp ============================================================================== --- usocket/branches/0.4.x/backend/scl.lisp (original) +++ usocket/branches/0.4.x/backend/scl.lisp Wed Nov 26 16:18:06 2008 @@ -39,9 +39,9 @@ (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and local-host-p (not patch-udp-p)) - (unsupported 'local-host 'socket-connect :minimum "1.3.8.2")) + (unsupported 'local-host 'socket-connect :minimum "1.3.9")) (when (and local-port-p (not patch-udp-p)) - (unsupported 'local-port 'socket-connect :minimum "1.3.8.2")) + (unsupported 'local-port 'socket-connect :minimum "1.3.9")) (let* ((socket (let ((args (list (host-to-hbo host) port :kind :stream))) (when (and patch-udp-p (or local-host-p local-port-p)) Modified: usocket/branches/experimental-udp/backend/scl.lisp ============================================================================== --- usocket/branches/experimental-udp/backend/scl.lisp (original) +++ usocket/branches/experimental-udp/backend/scl.lisp Wed Nov 26 16:18:06 2008 @@ -39,9 +39,9 @@ (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and local-host-p (not patch-udp-p)) - (unsupported 'local-host 'socket-connect :minimum "1.3.8.2")) + (unsupported 'local-host 'socket-connect :minimum "1.3.9")) (when (and local-port-p (not patch-udp-p)) - (unsupported 'local-port 'socket-connect :minimum "1.3.8.2")) + (unsupported 'local-port 'socket-connect :minimum "1.3.9")) (let ((socket)) (ecase protocol @@ -62,7 +62,7 @@ (error 'unsupported :feature '(protocol :datagram) :context 'socket-connect - :minumum "1.3.8.2 or ask a udp-patch from SCL maintainer")) + :minumum "1.3.9")) (setf socket (if (and host port) (let ((args (list (host-to-hbo host) port :kind protocol))) Modified: usocket/trunk/backend/scl.lisp ============================================================================== --- usocket/trunk/backend/scl.lisp (original) +++ usocket/trunk/backend/scl.lisp Wed Nov 26 16:18:06 2008 @@ -39,9 +39,9 @@ (when deadline (unsupported 'deadline 'socket-connect)) (when timeout (unsupported 'timeout 'socket-connect)) (when (and local-host-p (not patch-udp-p)) - (unsupported 'local-host 'socket-connect :minimum "1.3.8.2")) + (unsupported 'local-host 'socket-connect :minimum "1.3.9")) (when (and local-port-p (not patch-udp-p)) - (unsupported 'local-port 'socket-connect :minimum "1.3.8.2")) + (unsupported 'local-port 'socket-connect :minimum "1.3.9")) (let* ((socket (let ((args (list (host-to-hbo host) port :kind :stream))) (when (and patch-udp-p (or local-host-p local-port-p)) From ctian at common-lisp.net Wed Nov 26 16:23:16 2008 From: ctian at common-lisp.net (Chun Tian (binghe)) Date: Wed, 26 Nov 2008 16:23:16 +0000 Subject: [usocket-cvs] r480 - usocket/branches/experimental-udp Message-ID: Author: ctian Date: Wed Nov 26 16:23:10 2008 New Revision: 480 Log: [udp] type fix for rtt.lisp from lispworks-udp source code, which fix compilation on (optimize ((safety 3) (debug 3))) on at least LispWorks Modified: usocket/branches/experimental-udp/rtt.lisp Modified: usocket/branches/experimental-udp/rtt.lisp ============================================================================== --- usocket/branches/experimental-udp/rtt.lisp (original) +++ usocket/branches/experimental-udp/rtt.lisp Wed Nov 26 16:23:10 2008 @@ -25,15 +25,15 @@ :documentation "#sec since 1/1/1970 at start, but we use Lisp time here")) (:documentation "RTT Info Class")) -(defvar *rtt-rxtmin* 2.0 "min retransmit timeout value, seconds") -(defvar *rtt-rxtmax* 60.0 "max retransmit timeout value, seconds") +(defvar *rtt-rxtmin* 2.0s0 "min retransmit timeout value, seconds") +(defvar *rtt-rxtmax* 60.0s0 "max retransmit timeout value, seconds") (defvar *rtt-maxnrexmt* 3 "max #times to retransmit") (defmethod rtt-rtocalc ((instance rtt-info-mixin)) "Calculate the RTO value based on current estimators: smoothed RTT plus four times the deviation." (with-slots (srtt rttvar) instance - (+ srtt (* 4.0 rttvar)))) + (+ srtt (* 4.0s0 rttvar)))) (defun rtt-minmax (rto) "rtt-minmax makes certain that the RTO is between the upper and lower limits." @@ -50,9 +50,9 @@ (defmethod rtt-init ((instance rtt-info-mixin)) (with-slots (base rtt srtt rttvar rto) instance (setf base (get-internal-real-time) - rtt 0.0 - srtt 0.0 - rttvar 0.75 + rtt 0.0s0 + srtt 0.0s0 + rttvar 0.75s0 rto (rtt-minmax (rtt-rtocalc instance))))) (defmethod rtt-ts ((instance rtt-info-mixin)) @@ -65,15 +65,15 @@ (defmethod rtt-stop ((instance rtt-info-mixin) (ms number)) (with-slots (rtt srtt rttvar rto) instance - (setf rtt (/ ms 1000.0)) + (setf rtt (/ ms 1000.0s0)) (let ((delta (- rtt srtt))) - (incf srtt (/ delta 8.0)) + (incf srtt (/ delta 8.0s0)) (incf rttvar (/ (- (abs delta) rttvar) 4.0))) (setf rto (rtt-minmax (rtt-rtocalc instance))))) (defmethod rtt-timeout ((instance rtt-info-mixin)) (with-slots (rto nrexmt) instance - (setf rto (* rto 2.0)) + (setf rto (* rto 2.0s0)) (< (incf nrexmt) *rtt-maxnrexmt*))) (defmethod rtt-newpack ((instance rtt-info-mixin))