- usocket-cvs@common-lisp.net - mailman3.common-lisp.net

[usocket-cvs] r673 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 27 Aug '11

27 Aug '11

Author: ctian Date: Fri Aug 26 22:46:28 2011 New Revision: 673 Log: [ACL] Fixed for Allegro CL modern mode (merged from trunk, r671) Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/backend/allegro.lisp usocket/branches/0.5.x/usocket.lisp Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Fri Aug 26 22:43:51 2011 (r672) +++ usocket/branches/0.5.x/CHANGES Fri Aug 26 22:46:28 2011 (r673) @@ -1,6 +1,7 @@ 0.5.4: * Bugfix: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer) +* Bugfix: [ACL] Fixed for Allegro CL modern mode. 0.5.3: Modified: usocket/branches/0.5.x/backend/allegro.lisp ============================================================================== --- usocket/branches/0.5.x/backend/allegro.lisp Fri Aug 26 22:43:51 2011 (r672) +++ usocket/branches/0.5.x/backend/allegro.lisp Fri Aug 26 22:46:28 2011 (r673) @@ -199,5 +199,5 @@ ;; [Same code is also used in openmcl.lisp] (dolist (x active-internal-sockets) (setf (state (gethash x (wait-list-map wait-list))) - :READ)) + :read)) wait-list))) Modified: usocket/branches/0.5.x/usocket.lisp ============================================================================== --- usocket/branches/0.5.x/usocket.lisp Fri Aug 26 22:43:51 2011 (r672) +++ usocket/branches/0.5.x/usocket.lisp Fri Aug 26 22:46:28 2011 (r673) @@ -325,11 +325,12 @@ (sockets-ready 0)) (dolist (x (wait-list-waiters socket-or-sockets)) (when (setf (state x) - #+(and win32 (or sbcl ecl)) NIL ; they cannot relay on LISTEN + #+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN #-(and win32 (or sbcl ecl)) (if (and (stream-usocket-p x) (listen (socket-stream x))) - :READ NIL)) + :read + nil)) (incf sockets-ready))) ;; the internal routine is responsibe for ;; making sure the wait doesn't block on socket-streams of

1 0

[usocket-cvs] r672 - usocket/branches/0.5.x
by ctian＠common-lisp.net 27 Aug '11

27 Aug '11

Author: ctian Date: Fri Aug 26 22:43:51 2011 New Revision: 672 Log: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer) Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/package.lisp usocket/branches/0.5.x/usocket-test.asd usocket/branches/0.5.x/usocket.asd Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Tue Aug 16 00:58:22 2011 (r671) +++ usocket/branches/0.5.x/CHANGES Fri Aug 26 22:43:51 2011 (r672) @@ -1,3 +1,7 @@ +0.5.4: + +* Bugfix: [ECL] Fixed for ECL's MAKE-BUILD by removing some unecessary code (reported by Juan Jose Garcia-Ripoll, the ECL maintainer) + 0.5.3: * Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) Modified: usocket/branches/0.5.x/package.lisp ============================================================================== --- usocket/branches/0.5.x/package.lisp Tue Aug 16 00:58:22 2011 (r671) +++ usocket/branches/0.5.x/package.lisp Fri Aug 26 22:43:51 2011 (r672) @@ -3,8 +3,6 @@ ;;;; See the LICENSE file for licensing information. -(in-package :usocket-system) - (defpackage :usocket (:use :common-lisp #+abcl :java) (:export #:*wildcard-host* @@ -86,20 +84,3 @@ #:insufficient-implementation ; conditions regarding usocket support level #:unsupported #:unimplemented)) - -(in-package :usocket) - -;;; Logical Pathname Translations, learn from CL-HTTP source code - -(eval-when (:load-toplevel :execute) - (let* ((defaults #+asdf (asdf:component-pathname (asdf:find-system :usocket)) - #-asdf *load-truename*) - (home (make-pathname :name :wild :type :wild - :directory (append (pathname-directory defaults) - '(:wild-inferiors)) - :host (pathname-host defaults) - :defaults defaults - :version :newest))) - (setf (logical-pathname-translations "usocket") - `(("**;*.*.NEWEST" ,home) - ("**;*.*" ,home))))) Modified: usocket/branches/0.5.x/usocket-test.asd ============================================================================== --- usocket/branches/0.5.x/usocket-test.asd Tue Aug 16 00:58:22 2011 (r671) +++ usocket/branches/0.5.x/usocket-test.asd Fri Aug 26 22:43:51 2011 (r672) @@ -4,14 +4,6 @@ ;;;; See the LICENSE file for licensing information. -(in-package :cl-user) - -(unless (find-package ':usocket-system) - (make-package ':usocket-system - :use '(:cl :asdf))) - -(in-package :usocket-system) - (defsystem usocket-test :name "usocket test" :author "Erik Enge" Modified: usocket/branches/0.5.x/usocket.asd ============================================================================== --- usocket/branches/0.5.x/usocket.asd Tue Aug 16 00:58:22 2011 (r671) +++ usocket/branches/0.5.x/usocket.asd Fri Aug 26 22:43:51 2011 (r672) @@ -4,13 +4,6 @@ ;;;; See the LICENSE file for licensing information. -(in-package :cl-user) - -(defpackage usocket-system - (:use :cl :asdf)) - -(in-package :usocket-system) - (defsystem usocket :name "usocket" :author "Erik Enge & Erik Huelsmann"

1 0

[usocket-cvs] r671 - in usocket/trunk: . backend
by hhubner＠common-lisp.net 16 Aug '11

16 Aug '11

Author: hhubner Date: Tue Aug 16 00:58:22 2011 New Revision: 671 Log: Allegro CL modern mode fixes Modified: usocket/trunk/backend/allegro.lisp usocket/trunk/usocket.lisp Modified: usocket/trunk/backend/allegro.lisp ============================================================================== --- usocket/trunk/backend/allegro.lisp Fri Aug 12 23:08:37 2011 (r670) +++ usocket/trunk/backend/allegro.lisp Tue Aug 16 00:58:22 2011 (r671) @@ -199,5 +199,5 @@ ;; [Same code is also used in openmcl.lisp] (dolist (x active-internal-sockets) (setf (state (gethash x (wait-list-map wait-list))) - :READ)) + :read)) wait-list))) Modified: usocket/trunk/usocket.lisp ============================================================================== --- usocket/trunk/usocket.lisp Fri Aug 12 23:08:37 2011 (r670) +++ usocket/trunk/usocket.lisp Tue Aug 16 00:58:22 2011 (r671) @@ -325,11 +325,12 @@ (sockets-ready 0)) (dolist (x (wait-list-waiters socket-or-sockets)) (when (setf (state x) - #+(and win32 (or sbcl ecl)) NIL ; they cannot relay on LISTEN + #+(and win32 (or sbcl ecl)) nil ; they cannot rely on LISTEN #-(and win32 (or sbcl ecl)) (if (and (stream-usocket-p x) (listen (socket-stream x))) - :READ NIL)) + :read + nil)) (incf sockets-ready))) ;; the internal routine is responsibe for ;; making sure the wait doesn't block on socket-streams of

1 0

[usocket-cvs] r669 - usocket/tags/0.5.3
by ctian＠common-lisp.net 13 Aug '11

13 Aug '11

Author: ctian Date: Fri Aug 12 22:59:28 2011 New Revision: 669 Log: Created tag 0.5.3. Added: usocket/tags/0.5.3/ - copied from r668, usocket/branches/0.5.x/

1 0

[usocket-cvs] r668 - in usocket/trunk: . backend
by ctian＠common-lisp.net 13 Aug '11

13 Aug '11

Author: ctian Date: Fri Aug 12 22:58:27 2011 New Revision: 668 Log: Merge all changes from branch 0.5.x (r663-667) before tagging 0.5.3 Modified: usocket/trunk/CHANGES usocket/trunk/backend/lispworks.lisp usocket/trunk/backend/mcl.lisp usocket/trunk/backend/sbcl.lisp Modified: usocket/trunk/CHANGES ============================================================================== --- usocket/trunk/CHANGES Mon Aug 8 07:20:23 2011 (r667) +++ usocket/trunk/CHANGES Fri Aug 12 22:58:27 2011 (r668) @@ -1,3 +1,10 @@ +0.5.3: + +* Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) +* Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) +* Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project). +* Bugfix: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola. + 0.5.2: * General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms. Modified: usocket/trunk/backend/lispworks.lisp ============================================================================== --- usocket/trunk/backend/lispworks.lisp Mon Aug 8 07:20:23 2011 (r667) +++ usocket/trunk/backend/lispworks.lisp Fri Aug 12 22:58:27 2011 (r668) @@ -28,8 +28,7 @@ #+win32 (eval-when (:load-toplevel :execute) - (fli:register-module "ws2_32") - (comm::ensure-sockets)) + (fli:register-module "ws2_32")) (fli:define-foreign-function (get-host-name-internal "gethostname" :source) ((return-string (:reference-return (:ef-mb-string :limit 257))) @@ -188,6 +187,20 @@ "Open a unconnected UDP socket. For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL), for binding on random free unused port, set LOCAL-PORT to 0." + + ;; Note: move (ensure-sockets) here to make sure delivered applications + ;; correctly have networking support initialized. + ;; + ;; Following words was from Martin Simmons, forwarded by Camille Troillard: + + ;; Calling comm::ensure-sockets at load time looks like a bug in Lispworks-udp + ;; (it is too early and also unnecessary). + + ;; The LispWorks comm package calls comm::ensure-sockets when it is needed, so I + ;; think open-udp-socket should probably do it too. Calling it more than once is + ;; safe and it will be very fast after the first time. + #+win32 (comm::ensure-sockets) + (let ((socket-fd (comm::socket comm::*socket_af_inet* *socket_sock_dgram* *socket_ip_proto_udp*))) (if socket-fd (progn Modified: usocket/trunk/backend/mcl.lisp ============================================================================== --- usocket/trunk/backend/mcl.lisp Mon Aug 8 07:20:23 2011 (r667) +++ usocket/trunk/backend/mcl.lisp Fri Aug 12 22:58:27 2011 (r668) @@ -98,7 +98,7 @@ (socket (with-mapped-conditions () (make-instance 'passive-socket :local-port port - :local-host host + :local-host (host-to-hbo host) :reuse-address reuseaddress :backlog backlog)))) (make-stream-server-socket socket :element-type element-type))) @@ -230,8 +230,7 @@ (declare (special ccl::*passive-interface-address*)) new)) - -(defun wait-for-input-internal (wait-list &key timeout &aux result) +(defmethod input-available-p ((stream ccl::opentransport-stream)) (macrolet ((when-io-buffer-lock-grabbed ((lock &optional multiple-value-p) &body body) "Evaluates the body if and only if the lock is successfully grabbed" ;; like with-io-buffer-lock-grabbed but returns immediately instead of polling the lock @@ -249,23 +248,34 @@ (declare (type ccl::lock lock)) ;; crucial - clears bogus lock.value as in grab-io-buffer-lock-out-of-line: (ccl::%io-buffer-lock-really-grabbed-p lock) - (ccl:store-conditional lock nil ccl:*current-process*)) - (input-available (stream) - "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock" - (let ((io-buffer (ccl::stream-io-buffer stream))) - (or (not (eql 0 (ccl::io-buffer-incount io-buffer))) - (ccl::io-buffer-untyi-char io-buffer) - (locally (declare (optimize (speed 3) (safety 0))) - (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer)) - (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer)))))) - (ready-sockets (sockets) - (dolist (sock sockets result) - (when (input-available (socket-stream sock)) - (push sock result))))) - (with-mapped-conditions () - (ccl:process-wait-with-timeout - "socket input" - (when timeout (truncate (* timeout 60))) - #'ready-sockets - (wait-list-waiters wait-list))) - (nreverse result)))) + (ccl:store-conditional lock nil ccl:*current-process*))) + "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock" + (let ((io-buffer (ccl::stream-io-buffer stream))) + (or (not (eql 0 (ccl::io-buffer-incount io-buffer))) + (ccl::io-buffer-untyi-char io-buffer) + (locally (declare (optimize (speed 3) (safety 0))) + (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer)) + (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer)))))))) + +(defmethod connection-established-p ((stream ccl::opentransport-stream)) + (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil)) + (let ((state (ccl::opentransport-stream-connection-state stream))) + (not (eq :unbnd state))))) + +(defun wait-for-input-internal (wait-list &key timeout &aux result) + (labels ((ready-sockets (sockets) + (dolist (sock sockets result) + (when (cond ((stream-usocket-p sock) + (input-available-p (socket-stream sock))) + ((stream-server-usocket-p sock) + (let ((ot-stream (first (socket-streams (socket sock))))) + (or (input-available-p ot-stream) + (connection-established-p ot-stream))))) + (push sock result))))) + (with-mapped-conditions () + (ccl:process-wait-with-timeout + "socket input" + (when timeout (truncate (* timeout 60))) + #'ready-sockets + (wait-list-waiters wait-list))) + (nreverse result))) Modified: usocket/trunk/backend/sbcl.lisp ============================================================================== --- usocket/trunk/backend/sbcl.lisp Mon Aug 8 07:20:23 2011 (r667) +++ usocket/trunk/backend/sbcl.lisp Fri Aug 12 22:58:27 2011 (r668) @@ -298,10 +298,24 @@ ;; Now that we're connected make the stream. (setf (socket-stream usocket) (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - :element-type element-type)))) + :input t :output t :buffering :full + :element-type element-type + ;; Robert Brown <robert.brown(a)gmail.com> said on Aug 4, 2011: + ;; ... This means that SBCL streams created by usocket have a true + ;; serve-events property. When writing large amounts of data to several + ;; streams, the kernel will eventually stop accepting data from SBCL. + ;; When this happens, SBCL either waits for I/O to be possible on + ;; the file descriptor it's writing to or queues the data to be flushed later. + ;; Because usocket streams specify serve-events as true, SBCL + ;; always queues. Instead, it should wait for I/O to be available and + ;; write the remaining data to the socket. That's what serve-events + ;; equal to NIL gets you. + ;; + ;; Nikodemus Siivola <nikodemus(a)random-state.net> said on Aug 8, 2011: + ;; It's set to T for purely historical reasons, and will soon change to + ;; NIL in SBCL. (The docstring has warned of T being a temporary default + ;; for as long as the :SERVE-EVENTS keyword argument has existed.) + :serve-events nil)))) (:datagram (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket

1 0

[usocket-cvs] r667 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 08 Aug '11

08 Aug '11

Author: ctian Date: Mon Aug 8 07:20:23 2011 New Revision: 667 Log: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola. Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/backend/sbcl.lisp Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Thu Jun 30 09:38:18 2011 (r666) +++ usocket/branches/0.5.x/CHANGES Mon Aug 8 07:20:23 2011 (r667) @@ -3,6 +3,7 @@ * Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) * Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) * Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project). +* Bugfix: [SBCL] Fixed for "SBCL data flush problem", reported by Robert Brown and confirmed by Nikodemus Siivola. 0.5.2: Modified: usocket/branches/0.5.x/backend/sbcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/sbcl.lisp Thu Jun 30 09:38:18 2011 (r666) +++ usocket/branches/0.5.x/backend/sbcl.lisp Mon Aug 8 07:20:23 2011 (r667) @@ -298,10 +298,24 @@ ;; Now that we're connected make the stream. (setf (socket-stream usocket) (sb-bsd-sockets:socket-make-stream socket - :input t - :output t - :buffering :full - :element-type element-type)))) + :input t :output t :buffering :full + :element-type element-type + ;; Robert Brown <robert.brown(a)gmail.com> said on Aug 4, 2011: + ;; ... This means that SBCL streams created by usocket have a true + ;; serve-events property. When writing large amounts of data to several + ;; streams, the kernel will eventually stop accepting data from SBCL. + ;; When this happens, SBCL either waits for I/O to be possible on + ;; the file descriptor it's writing to or queues the data to be flushed later. + ;; Because usocket streams specify serve-events as true, SBCL + ;; always queues. Instead, it should wait for I/O to be available and + ;; write the remaining data to the socket. That's what serve-events + ;; equal to NIL gets you. + ;; + ;; Nikodemus Siivola <nikodemus(a)random-state.net> said on Aug 8, 2011: + ;; It's set to T for purely historical reasons, and will soon change to + ;; NIL in SBCL. (The docstring has warned of T being a temporary default + ;; for as long as the :SERVE-EVENTS keyword argument has existed.) + :serve-events nil)))) (:datagram (when (or local-host local-port) (sb-bsd-sockets:socket-bind socket

1 0

[usocket-cvs] r666 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 30 Jun '11

30 Jun '11

Author: ctian Date: Thu Jun 30 09:38:18 2011 New Revision: 666 Log: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications. Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/backend/lispworks.lisp Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Sun Jun 26 08:55:52 2011 (r665) +++ usocket/branches/0.5.x/CHANGES Thu Jun 30 09:38:18 2011 (r666) @@ -1,7 +1,8 @@ 0.5.3: -* [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) -* [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) +* Bugfix: [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) +* Bugfix: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) +* Bugfix: [LispWorks] Fixed using OPEN-UDP-SOCKET in delivered applications (thanks to Camille Troillard and Martin Simmons, this fix is from LispWorks-UDP project). 0.5.2: Modified: usocket/branches/0.5.x/backend/lispworks.lisp ============================================================================== --- usocket/branches/0.5.x/backend/lispworks.lisp Sun Jun 26 08:55:52 2011 (r665) +++ usocket/branches/0.5.x/backend/lispworks.lisp Thu Jun 30 09:38:18 2011 (r666) @@ -28,8 +28,7 @@ #+win32 (eval-when (:load-toplevel :execute) - (fli:register-module "ws2_32") - (comm::ensure-sockets)) + (fli:register-module "ws2_32")) (fli:define-foreign-function (get-host-name-internal "gethostname" :source) ((return-string (:reference-return (:ef-mb-string :limit 257))) @@ -188,6 +187,20 @@ "Open a unconnected UDP socket. For binding on address ANY(*), just not set LOCAL-ADDRESS (NIL), for binding on random free unused port, set LOCAL-PORT to 0." + + ;; Note: move (ensure-sockets) here to make sure delivered applications + ;; correctly have networking support initialized. + ;; + ;; Following words was from Martin Simmons, forwarded by Camille Troillard: + + ;; Calling comm::ensure-sockets at load time looks like a bug in Lispworks-udp + ;; (it is too early and also unnecessary). + + ;; The LispWorks comm package calls comm::ensure-sockets when it is needed, so I + ;; think open-udp-socket should probably do it too. Calling it more than once is + ;; safe and it will be very fast after the first time. + #+win32 (comm::ensure-sockets) + (let ((socket-fd (comm::socket comm::*socket_af_inet* *socket_sock_dgram* *socket_ip_proto_udp*))) (if socket-fd (progn

1 0

[usocket-cvs] r665 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 26 Jun '11

26 Jun '11

Author: ctian Date: Sun Jun 26 08:55:52 2011 New Revision: 665 Log: [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/backend/mcl.lisp Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Sat Jun 25 18:15:16 2011 (r664) +++ usocket/branches/0.5.x/CHANGES Sun Jun 26 08:55:52 2011 (r665) @@ -1,6 +1,7 @@ 0.5.3: -* [MCL] fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) +* [MCL] Fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) +* [MCL] Fixed WAIT-FOR-INPUT on passive sockets (stream-server-usocket) 0.5.2: Modified: usocket/branches/0.5.x/backend/mcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 18:15:16 2011 (r664) +++ usocket/branches/0.5.x/backend/mcl.lisp Sun Jun 26 08:55:52 2011 (r665) @@ -230,7 +230,7 @@ (declare (special ccl::*passive-interface-address*)) new)) -(defun input-available-p (stream) +(defmethod input-available-p ((stream ccl::opentransport-stream)) (macrolet ((when-io-buffer-lock-grabbed ((lock &optional multiple-value-p) &body body) "Evaluates the body if and only if the lock is successfully grabbed" ;; like with-io-buffer-lock-grabbed but returns immediately instead of polling the lock @@ -257,19 +257,21 @@ (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer)) (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer)))))))) -(defparameter *passive-polling-delay* 1/60) +(defmethod connection-established-p ((stream ccl::opentransport-stream)) + (ccl::with-io-buffer-locked ((ccl::stream-io-buffer stream nil)) + (let ((state (ccl::opentransport-stream-connection-state stream))) + (not (eq :unbnd state))))) (defun wait-for-input-internal (wait-list &key timeout &aux result) (labels ((ready-sockets (sockets) - (or (dolist (sock sockets result) - (when (cond ((stream-usocket-p sock) - (input-available-p (socket-stream sock))) - ((stream-server-usocket-p sock) - (input-available-p (car (socket-streams (socket sock)))))) - (push sock result))) - (unless (and timeout (zerop timeout)) - (sleep *passive-polling-delay*) - NIL)))) + (dolist (sock sockets result) + (when (cond ((stream-usocket-p sock) + (input-available-p (socket-stream sock))) + ((stream-server-usocket-p sock) + (let ((ot-stream (first (socket-streams (socket sock))))) + (or (input-available-p ot-stream) + (connection-established-p ot-stream))))) + (push sock result))))) (with-mapped-conditions () (ccl:process-wait-with-timeout "socket input"

1 0

[usocket-cvs] r664 - usocket/branches/0.5.x/backend
by ctian＠common-lisp.net 26 Jun '11

26 Jun '11

Author: ctian Date: Sat Jun 25 18:15:16 2011 New Revision: 664 Log: [mcl] separated input-available-p from wait-for-input-internel; add polling delay to prevent 100% CPU payload as suggest by Terje Modified: usocket/branches/0.5.x/backend/mcl.lisp Modified: usocket/branches/0.5.x/backend/mcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 00:02:05 2011 (r663) +++ usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 18:15:16 2011 (r664) @@ -230,8 +230,7 @@ (declare (special ccl::*passive-interface-address*)) new)) - -(defun wait-for-input-internal (wait-list &key timeout &aux result) +(defun input-available-p (stream) (macrolet ((when-io-buffer-lock-grabbed ((lock &optional multiple-value-p) &body body) "Evaluates the body if and only if the lock is successfully grabbed" ;; like with-io-buffer-lock-grabbed but returns immediately instead of polling the lock @@ -249,23 +248,32 @@ (declare (type ccl::lock lock)) ;; crucial - clears bogus lock.value as in grab-io-buffer-lock-out-of-line: (ccl::%io-buffer-lock-really-grabbed-p lock) - (ccl:store-conditional lock nil ccl:*current-process*)) - (input-available (stream) - "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock" - (let ((io-buffer (ccl::stream-io-buffer stream))) - (or (not (eql 0 (ccl::io-buffer-incount io-buffer))) - (ccl::io-buffer-untyi-char io-buffer) - (locally (declare (optimize (speed 3) (safety 0))) - (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer)) - (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer)))))) - (ready-sockets (sockets) - (dolist (sock sockets result) - (when (input-available (socket-stream sock)) - (push sock result))))) - (with-mapped-conditions () - (ccl:process-wait-with-timeout - "socket input" - (when timeout (truncate (* timeout 60))) - #'ready-sockets - (wait-list-waiters wait-list))) - (nreverse result)))) + (ccl:store-conditional lock nil ccl:*current-process*))) + "similar to stream-listen on buffered-input-stream-mixin but without waiting for lock" + (let ((io-buffer (ccl::stream-io-buffer stream))) + (or (not (eql 0 (ccl::io-buffer-incount io-buffer))) + (ccl::io-buffer-untyi-char io-buffer) + (locally (declare (optimize (speed 3) (safety 0))) + (when-io-buffer-lock-grabbed ((ccl::io-buffer-lock io-buffer)) + (funcall (ccl::io-buffer-listen-function io-buffer) stream io-buffer)))))))) + +(defparameter *passive-polling-delay* 1/60) + +(defun wait-for-input-internal (wait-list &key timeout &aux result) + (labels ((ready-sockets (sockets) + (or (dolist (sock sockets result) + (when (cond ((stream-usocket-p sock) + (input-available-p (socket-stream sock))) + ((stream-server-usocket-p sock) + (input-available-p (car (socket-streams (socket sock)))))) + (push sock result))) + (unless (and timeout (zerop timeout)) + (sleep *passive-polling-delay*) + NIL)))) + (with-mapped-conditions () + (ccl:process-wait-with-timeout + "socket input" + (when timeout (truncate (* timeout 60))) + #'ready-sockets + (wait-list-waiters wait-list))) + (nreverse result)))

1 0

[usocket-cvs] r663 - in usocket/branches/0.5.x: . backend
by ctian＠common-lisp.net 25 Jun '11

25 Jun '11

Author: ctian Date: Sat Jun 25 00:02:05 2011 New Revision: 663 Log: [MCL] fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) Modified: usocket/branches/0.5.x/CHANGES usocket/branches/0.5.x/backend/mcl.lisp Modified: usocket/branches/0.5.x/CHANGES ============================================================================== --- usocket/branches/0.5.x/CHANGES Wed May 11 06:15:51 2011 (r662) +++ usocket/branches/0.5.x/CHANGES Sat Jun 25 00:02:05 2011 (r663) @@ -1,3 +1,7 @@ +0.5.3: + +* [MCL] fixed SOCKET-LISTEN on vector addresses like #(0 0 0 0) + 0.5.2: * General: [SBCL] SOCKET-CONNECT's TIMEOUT argument was limited on non-Windows platforms. Modified: usocket/branches/0.5.x/backend/mcl.lisp ============================================================================== --- usocket/branches/0.5.x/backend/mcl.lisp Wed May 11 06:15:51 2011 (r662) +++ usocket/branches/0.5.x/backend/mcl.lisp Sat Jun 25 00:02:05 2011 (r663) @@ -98,7 +98,7 @@ (socket (with-mapped-conditions () (make-instance 'passive-socket :local-port port - :local-host host + :local-host (host-to-hbo host) :reuse-address reuseaddress :backlog backlog)))) (make-stream-server-socket socket :element-type element-type)))

1 0