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"