[nongnu] elpa/slime eafb23cdaf: sbcl, thread-status: show if it's waiting on a mutex.

[ELPA Syncer]

branch: elpa/slime
commit eafb23cdaf80ef1c60558c756fcc1479aafc5325
Author: Stas Boukarev <stassats@gmail.com>
Commit: Stas Boukarev <stassats@gmail.com>

    sbcl, thread-status: show if it's waiting on a mutex.
---
 swank/sbcl.lisp | 18 ++++++++++++++----
 1 file changed, 14 insertions(+), 4 deletions(-)

diff --git a/swank/sbcl.lisp b/swank/sbcl.lisp
index 7e68139a59..ae00410c2b 100644
--- a/swank/sbcl.lisp
+++ b/swank/sbcl.lisp
@@ -1724,12 +1724,22 @@ stack."
 
   (defimplementation thread-name (thread)
     ;; sometimes the name is not a string (e.g. NIL)
-    (princ-to-string (sb-thread:thread-name thread)))
+    (sb-thread:thread-name thread))
 
   (defimplementation thread-status (thread)
-    (if (sb-thread:thread-alive-p thread)
-        "Running"
-        "Stopped"))
+    #+sb-thread
+    (let ((waiting (sb-thread::thread-waiting-for thread)))
+      (cond ((and (typep waiting 'sb-thread:mutex)
+                  (let ((owner (sb-thread:mutex-owner waiting)))
+                    (and owner
+                         (format nil "Waiting on a mutex~@[ (~a)~] held by 
~a~@[ ~a~]"
+                                 (sb-thread:mutex-name waiting)
+                                 (thread-id owner)
+                                 (thread-name owner))))))
+            ((sb-thread:thread-alive-p thread)
+             "Running")
+            (t
+             "Stopped"))))
 
   (defimplementation make-lock (&key name)
     (sb-thread:make-mutex :name name))