[nongnu] elpa/slime c62ad116ba 3/3: Merge remote-tracking branch 'refs/remotes/upstream/slime/main' into elpa--merge/slime

[ELPA Syncer]

branch: elpa/slime
commit c62ad116ba4e2de3bde7fd390b0574e132c5f6b0
Merge: 3c34375670 cd745dae17
Author: ELPA Syncer <elpasync@gnu.org>
Commit: ELPA Syncer <elpasync@gnu.org>

    Merge remote-tracking branch 'refs/remotes/upstream/slime/main' into 
elpa--merge/slime
---
 slime-tests.el  |  3 ++
 swank/sbcl.lisp | 98 +++++++++++++++++++++++++++++++--------------------------
 2 files changed, 56 insertions(+), 45 deletions(-)

diff --git a/slime-tests.el b/slime-tests.el
index cc68339334..17a7349d0c 100644
--- a/slime-tests.el
+++ b/slime-tests.el
@@ -1179,6 +1179,9 @@ on *DEBUGGER-HOOK*."
     "Signalling END-OF-FILE should invoke the debugger."
     '(((cl:error 'cl:end-of-file :stream cl:*standard-input*))
       ((cl:read-from-string "")))
+  (when (and noninteractive
+             (equal (slime-lisp-implementation-name) "ccl"))
+    (slime-skip-test "potential deadlocks"))
   (let ((value (slime-eval
                 `(cl:let ((condition nil))
                          (cl:with-simple-restart
diff --git a/swank/sbcl.lisp b/swank/sbcl.lisp
index a8729cda6e..7e68139a59 100644
--- a/swank/sbcl.lisp
+++ b/swank/sbcl.lisp
@@ -1665,55 +1665,63 @@ stack."
 #+(and sb-thread
        #.(swank/backend:with-symbol "THREAD-NAME" "SB-THREAD"))
 (progn
-  (defvar *thread-id-counter* 0)
-
-  (defvar *thread-id-counter-lock*
-    (sb-thread:make-mutex :name "thread id counter lock"))
-
-  (defun next-thread-id ()
-    (sb-thread:with-mutex (*thread-id-counter-lock*)
-      (incf *thread-id-counter*)))
-
-  (defvar *thread-id-map* (make-hash-table))
-
-  ;; This should be a thread -> id map but as weak keys are not
-  ;; supported it is id -> map instead.
-  (defvar *thread-id-map-lock*
-    (sb-thread:make-mutex :name "thread id map lock"))
+  #-#.(swank/backend:with-symbol "THREAD-OS-TID" "SB-THREAD")
+  (progn
+    (defvar *thread-id-counter* 0)
+
+    (defvar *thread-id-counter-lock*
+      (sb-thread:make-mutex :name "thread id counter lock"))
+
+    (defun next-thread-id ()
+      (sb-thread:with-mutex (*thread-id-counter-lock*)
+        (incf *thread-id-counter*)))
+
+    (defvar *thread-id-map* (make-hash-table))
+
+    ;; This should be a thread -> id map but as weak keys are not
+    ;; supported it is id -> map instead.
+    (defvar *thread-id-map-lock*
+      (sb-thread:make-mutex :name "thread id map lock"))
+
+    (defimplementation thread-id (thread)
+      (block thread-id
+        (sb-thread:with-mutex (*thread-id-map-lock*)
+          (loop for id being the hash-key in *thread-id-map*
+                using (hash-value thread-pointer)
+                do
+                (let ((maybe-thread (sb-ext:weak-pointer-value 
thread-pointer)))
+                  (cond ((null maybe-thread)
+                         ;; the value is gc'd, remove it manually
+                         (remhash id *thread-id-map*))
+                        ((eq thread maybe-thread)
+                         (return-from thread-id id)))))
+          ;; lazy numbering
+          (let ((id (next-thread-id)))
+            (setf (gethash id *thread-id-map*) (sb-ext:make-weak-pointer 
thread))
+            id))))
+
+    (defimplementation find-thread (id)
+      (sb-thread:with-mutex (*thread-id-map-lock*)
+        (let ((thread-pointer (gethash id *thread-id-map*)))
+          (if thread-pointer
+              (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
+                (if maybe-thread
+                    maybe-thread
+                    ;; the value is gc'd, remove it manually
+                    (progn
+                      (remhash id *thread-id-map*)
+                      nil)))
+              nil)))))
+  #+#.(swank/backend:with-symbol "THREAD-OS-TID" "SB-THREAD")
+  (progn
+    (defimplementation thread-id (thread)
+      (sb-thread::thread-os-tid thread))
+    (defimplementation find-thread (id)
+      (find id (sb-thread:list-all-threads) :key #'sb-thread::thread-os-tid)))
 
   (defimplementation spawn (fn &key name)
     (sb-thread:make-thread fn :name name))
 
-  (defimplementation thread-id (thread)
-    (block thread-id
-      (sb-thread:with-mutex (*thread-id-map-lock*)
-        (loop for id being the hash-key in *thread-id-map*
-              using (hash-value thread-pointer)
-              do
-              (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
-                (cond ((null maybe-thread)
-                       ;; the value is gc'd, remove it manually
-                       (remhash id *thread-id-map*))
-                      ((eq thread maybe-thread)
-                       (return-from thread-id id)))))
-        ;; lazy numbering
-        (let ((id (next-thread-id)))
-          (setf (gethash id *thread-id-map*) (sb-ext:make-weak-pointer thread))
-          id))))
-
-  (defimplementation find-thread (id)
-    (sb-thread:with-mutex (*thread-id-map-lock*)
-      (let ((thread-pointer (gethash id *thread-id-map*)))
-        (if thread-pointer
-            (let ((maybe-thread (sb-ext:weak-pointer-value thread-pointer)))
-              (if maybe-thread
-                  maybe-thread
-                  ;; the value is gc'd, remove it manually
-                  (progn
-                    (remhash id *thread-id-map*)
-                    nil)))
-            nil))))
-
   (defimplementation thread-name (thread)
     ;; sometimes the name is not a string (e.g. NIL)
     (princ-to-string (sb-thread:thread-name thread)))