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

[Helmut Eller]

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

Modified Files:
	swank-openmcl.lisp 
Log Message:
(mailbox): Use a semaphore instead of process-wait.  Works better with
native threads.  Patch by Bryan O'Conner.

Date: Wed Feb  4 17:08:08 2004
Author: heller

Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.58 slime/swank-openmcl.lisp:1.59
--- slime/swank-openmcl.lisp:1.58	Sat Jan 31 10:07:35 2004
+++ slime/swank-openmcl.lisp	Wed Feb  4 17:08:07 2004
@@ -590,6 +590,7 @@
 
 (defstruct (mailbox (:conc-name mailbox.)) 
   (mutex (ccl:make-lock "thread mailbox"))
+  (semaphore (ccl:make-semaphore))
   (queue '() :type list))
 
 (defimplementation spawn (fn &key name)
@@ -640,11 +641,12 @@
          (mutex (mailbox.mutex mbox)))
     (ccl:with-lock-grabbed (mutex)
       (setf (mailbox.queue mbox)
-            (nconc (mailbox.queue mbox) (list message))))))
+            (nconc (mailbox.queue mbox) (list message)))
+      (ccl:signal-semaphore (mailbox.semaphore mbox)))))
 
 (defimplementation receive ()
   (let* ((mbox (mailbox ccl:*current-process*))
          (mutex (mailbox.mutex mbox)))
-    (ccl:process-wait "receive" #'mailbox.queue mbox)
+    (ccl:wait-on-semaphore (mailbox.semaphore mbox))
     (ccl:with-lock-grabbed (mutex)
       (pop (mailbox.queue mbox)))))