[slime-cvs] CVS slime

[CVS User nsiivola]

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

Modified Files:
	ChangeLog swank-backend.lisp swank-sbcl.lisp swank.lisp 
Log Message:
sbcl: workaround for auto-flush thread deadlocks

 Occasionally auto-flush thread could deadlock with a thread doing
 compilation:

   T1: grabs world-lock
   T2: decides to flush, grabs stream lock
   T1: needs to do output (compiler note, etc), waits on the stream lock
   T2: needs the world-lock for a while (PCL dispatch machinery setup, etc)

   KABOOM.

 This is an SBCL issue, no mistake about it -- but sorting out
 the world-lock handling is going to take a while, and sticking
 a deadline around the FINISH-OUTPUT call avoids the issue.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/14 14:01:32	1.2200
+++ /project/slime/cvsroot/slime/ChangeLog	2011/06/14 15:34:18	1.2201
@@ -1,5 +1,10 @@
 2011-06-14  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* swank-backend.lisp (call-with-io-timeout): New DEFINTERFACE.
+	* swank-sbcl.lisp (call-with-io-timeout): DEFIMPLEMENTATION for it.
+	* swank.lisp (auto-flush-loop): Call FINISH-OUTPUT using
+	CALL-WITH-IO-TIMEOUT to prevent deadlocks.
+
 	* swank.lisp (macro-indentation): Fix handling of lambda-list
 	keywords other than &rest and &body.
 
--- /project/slime/cvsroot/slime/swank-backend.lisp	2010/11/07 19:48:21	1.205
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2011/06/14 15:34:18	1.206
@@ -1325,3 +1325,10 @@
 units, but other Lisps return the number of codepoints. The slime
 protocol wants string lengths in terms of codepoints."
   (length string))
+
+;;; Timeouts
+
+(definterface call-with-io-timeout (function &key seconds)
+  "Calls function with the specified IO timeout."
+  (declare (ignore seconds))
+  (funcall function))
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 14:00:37	1.282
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/14 15:34:18	1.283
@@ -1637,6 +1637,13 @@
                          :dual-channel-p t                         
                          :external-format external-format))
 
+(defimplementation call-with-io-timeout (function &key seconds)
+  (handler-case
+      (sb-sys:with-deadline (:seconds seconds)
+        (funcall function))
+    (sb-sys:deadline-timeout ()
+      nil)))
+
 #-win32
 (defimplementation background-save-image (filename &key restart-function
                                                    completion-function)
--- /project/slime/cvsroot/slime/swank.lisp	2011/06/14 14:01:32	1.746
+++ /project/slime/cvsroot/slime/swank.lisp	2011/06/14 15:34:18	1.747
@@ -1122,11 +1122,15 @@
 
 (defun auto-flush-loop (stream)
   (loop
-   (when (not (and (open-stream-p stream) 
-                   (output-stream-p stream)))
-     (return nil))
-   (finish-output stream)
-   (sleep *auto-flush-interval*)))
+    (when (not (and (open-stream-p stream) 
+                    (output-stream-p stream)))
+      (return nil))
+    ;; Use an IO timeout to avoid deadlocks
+    ;; on the stream we're flushing.
+    (call-with-io-timeout
+     (lambda () (finish-output stream))
+     :seconds 0.1)
+    (sleep *auto-flush-interval*)))
 
 (defun find-repl-thread (connection)
   (cond ((not (use-threads-p))