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)))