[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv19697

Modified Files:
	swank-openmcl.lisp 
Log Message:
(*in-receive-if*): New variable.
(receive-if): Use *in-receive-if* to recognize 
when wait-on-semaphore was interrupted and receive-if is called
recursively.


--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/08/03 18:23:10	1.126
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/08/03 19:24:09	1.127
@@ -961,6 +961,8 @@
 (defimplementation receive ()
   (receive-if (constantly t)))
 
+(defvar *in-receive-if* nil)
+
 (defimplementation receive-if (test)
   (let* ((mbox (mailbox ccl:*current-process*))
          (mutex (mailbox.mutex mbox)))
@@ -971,8 +973,11 @@
          (when tail 
            (setf (mailbox.queue mbox) 
                  (nconc (ldiff q tail) (cdr tail)))
+           (when *in-receive-if*
+             (ccl:signal-semaphore (mailbox.semaphore mbox)))
            (return (car tail)))))
-     (ccl:wait-on-semaphore (mailbox.semaphore mbox)))))
+     (let ((*in-receive-if* t))
+       (ccl:wait-on-semaphore (mailbox.semaphore mbox))))))
 
 (defimplementation quit-lisp ()
   (ccl::quit))