master: Add some remarks and a utility function

The branch "master" has been updated in SBCL:
       via  9b67e9100dfd518747d61d3a1fd8b986d09120d6 (commit)
      from  84d5a7b46b4637ec27bd537a3125001d4e0bface (commit)

- Log -----------------------------------------------------------------
commit 9b67e9100dfd518747d61d3a1fd8b986d09120d6
Author: Douglas Katzman <[email protected]>
Date:   Thu Apr 30 18:44:54 2026 -0400

    Add some remarks and a utility function
---
 src/code/target-thread.lisp  |  8 ++++++++
 src/code/thread-structs.lisp | 20 ++++++++++++++++++++
 src/runtime/sunos-os.c       |  1 +
 tests/threads.pure.lisp      |  5 +++++
 4 files changed, 34 insertions(+)

diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index cc7c8e412..51e253633 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -13,6 +13,7 @@
 
 ;;; symbols to protect from tree-shaker, for some tests
 (export '(%thread-local-references
+          %thread-from-tid
           get-spinlock
           release-spinlock
           spinlock
@@ -294,6 +295,13 @@ an error in that case."
          (let ((new (avl-insert old addr ,thread)))
            (when (eq old (setq old (sb-ext:cas *all-threads* old new))) (return)))))))
 
+(defun %thread-from-tid (os-tid)
+  (declare (type (unsigned-byte 32) os-tid))
+  (avltree-filter (lambda (node &aux (thread (avlnode-data node)))
+                    (when (= (thread-os-tid thread) os-tid)
+                      (return-from %thread-from-tid thread)))
+                  *all-threads*))
+
 (defun vmthread-name (vmthread)
   (binding* ((node (avl-find (vmthread-id->addr vmthread) *all-threads*) :exit-if-null)
              (thread (avlnode-data node) :exit-if-null)
diff --git a/src/code/thread-structs.lisp b/src/code/thread-structs.lisp
index cea4666b6..0ab169d80 100644
--- a/src/code/thread-structs.lisp
+++ b/src/code/thread-structs.lisp
@@ -27,6 +27,18 @@
 ;;; compete for a mutex, the pthread code seems to do a better job at reducing
 ;;; cycles spent in the OS.
 
+;;; Mutexes could be equipped with telemetry compatible with absl::Mutex.
+;;; Specifically, we'd like to know the "Induced wait" which is the sum of CPU cycles
+;;; a lock owner caused other threads to wait. It's tricky to report because measurement
+;;; is performed in the waiting thread (the "victim" of wait) but reporting should occur
+;;; in the "culprit" thread so that the call stack accurately reflects the function
+;;; whose fault it is that there was induced wait time. absl mutex can do this because
+;;; it is acutely aware of the queue of waiters, and it knows which waiter it wakes.
+;;; SBCL mutex can't, because we defer everything to the OS. But the delay time can be
+;;; handed off to -some- waker using a slot of the mutex, which stastically should result
+;;; in the right effect. To keep struct size unchanged, the owner ID and futex word
+;;; must be packed into a single raw slot. (None of this is implemented yet!)
+
 (sb-xc:defstruct (mutex (:constructor make-mutex (&key name))
                         (:copier nil))
   "Mutex type."
@@ -110,6 +122,14 @@ in future versions."
   ;; This value is 0 if the thread is not considered alive, though the pthread
   ;; may be running its termination code (unlinking from all_threads etc)
   (primitive-thread 0 :type sb-vm:word)
+  ;; It is absolutely critical that our OS thread identifiers take no more than 32 bits
+  ;; if #+sb-futex is present. So don't go changing this slot just because you feel like.
+  ;; * macOS (mach_port_t): unsigned int
+  ;; * FreeBSD (thr_self): thr_self writes a long to its its pointer arg,
+  ;;     however LWP IDs occupy a smaller range that can be cast to int
+  ;; * NetBSD (_lwp_self): lwpid_t which is int32_t
+  ;; * Linux (gettid): 32-bit pid_t
+  ;; * Windows (GetCurrentThreadId): 32-bit DWORD
   ;; Caution: the identified thread may have exited by the time you've read this slot
   (os-tid 0 :type (unsigned-byte 32) :read-only t)
   ;; This is a redundant copy of the pthread identifier from the primitive thread.
diff --git a/src/runtime/sunos-os.c b/src/runtime/sunos-os.c
index 0d1902564..16b197360 100644
--- a/src/runtime/sunos-os.c
+++ b/src/runtime/sunos-os.c
@@ -24,6 +24,7 @@
 
 #include "gc.h"
 
+// Allegedly this could use thr_self() or _lwp_self() both of which are 32-bit
 int sb_GetTID() { return 0; } // this doesn't affect anything
 
 void os_init() {}
diff --git a/tests/threads.pure.lisp b/tests/threads.pure.lisp
index d06aab37e..030e8cfd4 100644
--- a/tests/threads.pure.lisp
+++ b/tests/threads.pure.lisp
@@ -317,3 +317,8 @@
       (assert (string= (first results) "newname"))
       (assert (find "finalizer" (second results) :test 'string=))
       (assert (find "testme" (second results) :test 'string=)))))
+
+(with-test (:name :thread-from-tid)
+  (let ((tid (sb-thread:thread-os-tid *current-thread*)))
+    (when (plusp tid) ; SunOS returns 0
+      (assert (eq (sb-thread:%thread-from-tid tid) *current-thread*)))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL