[slime-cvs] CVS update: slime/swank-allegro.lisp

[Helmut Eller]

Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv31712

Modified Files:
	swank-allegro.lisp 
Log Message:
(send): Wait a bit if there are already many message in the mailbox.
Date: Tue Mar 23 16:34:19 2004
Author: heller

Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.24 slime/swank-allegro.lisp:1.25
--- slime/swank-allegro.lisp:1.24	Thu Mar 18 16:53:27 2004
+++ slime/swank-allegro.lisp	Tue Mar 23 16:34:18 2004
@@ -307,6 +307,11 @@
 (defimplementation send (thread message)
   (let* ((mbox (mailbox thread))
          (mutex (mailbox.mutex mbox)))
+    (mp:process-wait-with-timeout 
+     "yielding before sending" 0.1
+     (lambda ()
+       (mp:with-process-lock (mutex)
+         (< (length (mailbox.queue mbox) 10)))))
     (mp:with-process-lock (mutex)
       (setf (mailbox.queue mbox)
             (nconc (mailbox.queue mbox) (list message))))))