[usocket-cvs] r664 - usocket/branches/0.5.x/backend

[ctian at common-lisp.net]

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