[slime-cvs] CVS slime

[CVS User heller]

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
* swank-sbcl.lisp (stream-force-output): Don't use with-deadline.
Grab the world-lock instead.
(condition-timed-wait): Use the :timeout argument.

--- /project/slime/cvsroot/slime/ChangeLog	2012/05/11 06:52:05	1.2337
+++ /project/slime/cvsroot/slime/ChangeLog	2012/05/11 06:52:18	1.2338
@@ -1,5 +1,11 @@
 2012-05-11  Helmut Eller  <heller at common-lisp.net>
 
+	* swank-sbcl.lisp (stream-force-output): Don't use
+	with-deadline. Grab the world-lock instead.
+	(condition-timed-wait): Use the :timeout argument for real.
+
+2012-05-11  Helmut Eller  <heller at common-lisp.net>
+
 	* swank-backend.lisp (call-with-io-timeout): Not used. Deleted.
 	* swank-sbcl.lisp (call-with-io-timeout): Deleted.
 
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/05/11 06:52:05	1.319
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2012/05/11 06:52:18	1.320
@@ -1627,11 +1627,9 @@
 
   (defun condition-timed-wait (waitqueue mutex timeout)
     (macrolet ((foo ()
-                 (cond ((and (> (length (sb-introspect:function-lambda-list
-                                         #'sb-thread:condition-wait))
-                                2)
-                             nil  ; FIXME: :timeout doesn't work. Why?
-                             )
+                 (cond ((> (length (sb-introspect:function-lambda-list
+                                    #'sb-thread:condition-wait))
+                           2)
                         '(sb-thread:condition-wait waitqueue mutex
                           :timeout timeout))
                        ((member :sb-lutex *features*) ; Darwin
@@ -1695,12 +1693,8 @@
   (defclass slime-output-stream (fundamental-character-output-stream)
     ())
   (defmethod stream-force-output :around ((stream slime-output-stream))
-    (handler-case
-        (sb-sys:with-deadline (:seconds 0.1)
-          (call-next-method))
-      (sb-sys:deadline-timeout ()
-        nil)))
-
+    (sb-thread:with-mutex (sb-c::**world-lock** :wait-p nil)
+      (call-next-method)))
   )
 
 (defimplementation quit-lisp ()