master: Bit-pack mutex-owner and state into one slot if #+sb-futex
snuglas via Sbcl-commits <[email protected]> Fri, 01 May 2026 03:16:46 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via bc13902c286979773016e3e7b84c6049ff53c320 (commit)
from a48121ddb348ca5a5e62c192e2fadb561eeb1347 (commit)
- Log -----------------------------------------------------------------
commit bc13902c286979773016e3e7b84c6049ff53c320
Author: Douglas Katzman <[email protected]>
Date: Thu Apr 30 23:15:52 2026 -0400
Bit-pack mutex-owner and state into one slot if #+sb-futex
Only for little-endian 64-bit. And if (and only if) doing it, then
represent mutex-owner as a kernel thread ID, not struct thread.
A slot becomes available for other uses without increasing the struct size
though #-compact-instance-header had a padding slot which could have been
taken. The size concern was for #+compact-instance-header.
---
src/code/target-thread.lisp | 95 ++++++++++++++++++++++++++++++++++++--------
src/code/thread-structs.lisp | 12 +++++-
src/code/thread.lisp | 20 +++++++---
src/cold/shared.lisp | 2 +
tests/futex-wait.test.sh | 12 ++++--
5 files changed, 114 insertions(+), 27 deletions(-)
diff --git a/src/code/target-thread.lisp b/src/code/target-thread.lisp
index f3a4d322a..3f1d2f338 100644
--- a/src/code/target-thread.lisp
+++ b/src/code/target-thread.lisp
@@ -302,6 +302,8 @@ an error in that case."
(return-from %thread-from-tid thread)))
*all-threads*))
+#-bitpacked-mutex
+(progn
(defun vmthread-name (vmthread)
(binding* ((node (avl-find (vmthread-id->addr vmthread) *all-threads*) :exit-if-null)
(thread (avlnode-data node) :exit-if-null)
@@ -334,7 +336,17 @@ an error in that case."
;; If people don't like seeing it, we could return instead
;; (LOAD-TIME-VALUE (%make-thread "dead-thread" nil nil))
;; indicating that you observed a value of %OWNER which no longer exists.
- (t :thread-dead)))
+ (t :thread-dead))))
+
+#+bitpacked-mutex
+(progn
+(defmacro pack-mutex-state (state owner) `(logior (ash ,owner 32) ,state))
+(defun vmthread-name (os-tid)
+ (or (awhen (%thread-from-tid os-tid) (thread-name it)) os-tid))
+(defun mutex-owner-lookup (os-tid)
+ (cond ((%thread-from-tid os-tid))
+ ((= os-tid 0) nil)
+ (t :thread-dead))))
(defun %list-all-threads ()
;; No lock needed, just an atomic read, since tree mutations can't happen.
@@ -504,7 +516,7 @@ See also: RETURN-FROM-THREAD and SB-EXT:EXIT."
;; which means 64-bit big-endian needs to add 4 bytes to get to the low half
;; of the slot, since we lack 32-bit raw slots.
:structure mutex
- :slot state
+ :slot %state
:byte-offset (+ #+(and 64-bit big-endian) 4))
(define-structure-slot-addressor waitqueue-token-address
:structure waitqueue
@@ -567,10 +579,12 @@ See also: RETURN-FROM-THREAD and SB-EXT:EXIT."
(labels ((detect-deadlock (lock limit)
(declare (fixnum limit))
(barrier (:read))
- (let ((other-vmthread-id (mutex-%owner lock)))
+ (let ((this-thread #+bitpacked-mutex (thread-os-tid *current-thread*)
+ #-bitpacked-mutex (current-vmthread-id))
+ (other-vmthread-id (mutex-%owner lock)))
(cond ((= limit 0) nil)
((= other-vmthread-id 0) nil)
- ((= (current-vmthread-id) other-vmthread-id)
+ ((= this-thread other-vmthread-id)
;; We're now committed to signaling the
;; error and breaking the deadlock, so
;; mark us as no longer waiting on the
@@ -733,7 +747,14 @@ returns NIL each time."
(declaim (inline %try-mutex))
(defun %try-mutex (mutex)
(declare (type mutex mutex) (optimize (speed 3)))
- #+sb-futex
+ #+bitpacked-mutex
+ (let* ((new (pack-mutex-state 1 (thread-os-tid *current-thread*)))
+ (old (sb-ext:cas (mutex-%state mutex) 0 new)))
+ (cond ((= old 0) t)
+ ((= (owner-tid-from-word old) (owner-tid-from-word new))
+ (error "Recursive lock attempt ~S." mutex))))
+
+ #+(and sb-futex (not bitpacked-mutex))
;; From the Mutex 2 algorithm from "Futexes are Tricky" by Ulrich Drepper.
(let ((id (current-vmthread-id)))
(cond ((= (sb-ext:cas (mutex-state mutex) 0 1) 0)
@@ -758,10 +779,11 @@ returns NIL each time."
;;; memory aid: this is "pthread_mutex_timedlock" without the pthread
;;; and no messing about with *DEADLINE* or deadlocks. It's just locking.
#+sb-thread
-(defun %mutex-timedlock (mutex to-sec to-usec stop-sec stop-usec)
+(defun %mutex-timedlock (mutex to-sec to-usec stop-sec stop-usec
+ &aux (os-tid (thread-os-tid *current-thread*)))
(declare (type mutex mutex) (optimize (speed 3)))
(declare (sb-ext:muffle-conditions sb-ext:compiler-note))
- (declare (ignorable to-sec to-usec))
+ (declare (ignorable to-sec to-usec os-tid))
;; This is a fairly direct translation of the Mutex 2 algorithm from
;; "Futexes are Tricky" by Ulrich Drepper.
;;
@@ -775,33 +797,42 @@ returns NIL each time."
;; }
;;
#+sb-futex
- (symbol-macrolet ((val (mutex-state mutex)))
- (let ((c (sb-ext:cas val 0 1))) ; available -> taken
+ (symbol-macrolet
+ ((val (mutex-%state mutex))
+ . #+bitpacked-mutex
+ ((cas-1->2 (sb-ext:cas (sap-ref-32 (int-sap (mutex-state-address mutex)) 0) 1 2))
+ (owned (pack-mutex-state 1 os-tid))
+ (contended (pack-mutex-state 2 os-tid))
+ (contended-p (eql (logand c 3) 2)))
+ #-bitpacked-mutex
+ ((cas-1->2 (sb-ext:cas (mutex-%state mutex) 1 2))
+ (owned 1) (contended 2) (contended-p (eql c 2))))
+ (let ((c (sb-ext:cas val 0 owned))) ; available -> taken
(unless (= c 0) ; Got it right off the bat?
(with-pinned-objects (mutex)
(nlx-protect
(if (not stop-sec)
(loop ; untimed
;; Mark it as contended, and sleep, unless it is now in state 0.
- (when (or (eql c 2) (/= 0 (sb-ext:cas val 1 2)))
+ (when (or contended-p (/= 0 cas-1->2))
(futex-wait (mutex-state-address mutex) 2 -1 0))
;; Try to get it, still marking it as contended.
- (when (= 0 (setq c (sb-ext:cas val 0 2))) (return))) ; win
+ (when (= 0 (setq c (sb-ext:cas val 0 contended))) (return))) ; win
(loop ; same as above but check for timeout
- (when (or (eql c 2) (/= 0 (sb-ext:cas val 1 2)))
+ (when (or contended-p (/= 0 cas-1->2))
(if (eql 1 (futex-wait (mutex-state-address mutex) 2 to-sec to-usec))
;; -1 = EWOULDBLOCK, possibly spurious wakeup
;; 0 = normal wakeup
;; 1 = ETIMEDOUT ***DONE***
;; 2 = EINTR, a spurious wakeup
(return-from %mutex-timedlock nil)))
- (when (= 0 (setq c (sb-ext:cas val 0 2))) (return)) ; win
+ (when (= 0 (setq c (sb-ext:cas val 0 contended))) (return)) ; win
;; Update timeout
(setf (values to-sec to-usec)
(sb-impl::relative-decoded-times stop-sec stop-usec))))
;; Unwinding because futex-wait allows interrupts, wake up another futex
(futex-wake (mutex-state-address mutex) 1)))))
- (setf (mutex-%owner mutex) (current-vmthread-id))
+ #-bitpacked-mutex (setf (mutex-%owner mutex) (current-vmthread-id))
t)
#-sb-futex
@@ -997,6 +1028,37 @@ The IF-NOT-OWNER keyword dictates behavior when the current thread does not own
mutex. Do nothing and silently return if :PUNT, signal a WARNING or ERROR if :WARN
or :ERROR respectively, or release the mutex anyway if :FORCE."
(declare (type mutex mutex))
+ #+bitpacked-mutex
+ (with-pinned-objects (mutex)
+ ;; A read barrier is strictly needed only in an erroneous call to RELEASE. In the non-
+ ;; bitpacked logic, CAS of "self" to 0 avoids the problem of thinking that this thread
+ ;; is the owner when it isn't. Without the CAS, supposing I thought I was the owning
+ ;; thread due to failing to observe a different thread's store- that would be horrible.
+ (let ((owner (owner-tid-from-word (progn (barrier (:read)) (mutex-%state mutex)))))
+ (when (= owner (thread-os-tid *current-thread*))
+ (let* ((old (pack-mutex-state 1 owner))
+ (actual (sb-ext:atomic-decf (mutex-%state mutex) old)))
+ (unless (eql actual old)
+ (setf (mutex-%state mutex) 0)
+ ;; The compiler is not going to reorder the above store after the syscall,
+ ;; so this barrier is just technical pedantry / documentation.
+ (sb-thread:barrier (:write))
+ (futex-wake (mutex-state-address mutex) 1)))
+ (return-from release-mutex nil))
+ ;; srsly? why would you not even want to know that your code is bad???
+ (when (eq if-not-owner :punt) (return-from release-mutex nil))
+ (ecase if-not-owner
+ (:force)
+ ((:warn :error)
+ (funcall (if (eq if-not-owner :warn) 'warn 'error)
+ "Releasing ~S, owned by another thread: ~S" mutex (vmthread-name owner))))
+ ;; Clear the whole control word and do a futex_wake. Don't bother trying to optimize
+ ;; the uncontended case because your code is already wrong if you get here.
+ (setf (mutex-%state mutex) 0) ; no guarantees about anything working now!!!
+ (sb-thread:barrier (:write))
+ (futex-wake (mutex-state-address mutex) 1)))
+
+ #-bitpacked-mutex
;; Order matters: set owner to NIL before releasing state.
(let* ((self (current-vmthread-id))
(old-owner (sb-ext:compare-and-swap (mutex-%owner mutex) self 0)))
@@ -1018,8 +1080,9 @@ or :ERROR respectively, or release the mutex anyway if :FORCE."
(setf (mutex-state mutex) 0)
(sb-thread:barrier (:write)) ; paranoid ?
(with-pinned-objects (mutex)
- (futex-wake (mutex-state-address mutex) 1)))
- nil)))
+ (futex-wake (mutex-state-address mutex) 1)))))
+
+ nil)
;;;; Waitqueues/condition variables
diff --git a/src/code/thread-structs.lisp b/src/code/thread-structs.lisp
index 5f45e08f0..519f1f156 100644
--- a/src/code/thread-structs.lisp
+++ b/src/code/thread-structs.lisp
@@ -42,16 +42,24 @@
(sb-xc:defstruct (mutex (:constructor make-mutex (&key name))
(:copier nil))
"Mutex type."
- #+sb-futex (state 0 :type sb-vm:word)
+ ;; If #+bitpacked-mutex then the upper half SB-VM:WORD is owner (as a kernel TID)
+ ;; and the low 32 bits are the futex word which takes a value from {0,1,2}.
+ ;; If #-bitpacked-mutex then the entire state word is the futex word.
+ #+sb-futex (%state 0 :type sb-vm:word)
;; If adding slots between STATE and NAME, please see futex_name() in linux_os.c
;; which attempts to divine a string from a futex word address.
(name nil :type (or null simple-string))
+ #+bitpacked-mutex (induced-wait 0 :type sb-vm:word)
;; The owner is a non-pointer so that GC pages containing mutexes do not get dirtied
;; with mutex ownership change. The natural representation of this is SB-VM:WORD
;; but the "funny fixnum" representation - i.e. N_WORD_BITS bits of significance, but
;; cast as fixnum when read - avoids consing on 32-bit builds, and also not all of them
;; implement RAW-INSTANCE-CAS which would be otherwise needed.
- (%owner 0 :type fixnum))
+ #-bitpacked-mutex (%owner 0 :type fixnum))
+
+(defmacro mutex-state (mu)
+ #-bitpacked-mutex `(mutex-%state ,mu)
+ #+bitpacked-mutex `(logand (mutex-%state ,mu) 3))
(sb-xc:defstruct (waitqueue (:copier nil) (:constructor make-waitqueue (&key name)))
"Waitqueue type."
diff --git a/src/code/thread.lisp b/src/code/thread.lisp
index 81196969f..81c7b6486 100644
--- a/src/code/thread.lisp
+++ b/src/code/thread.lisp
@@ -24,6 +24,10 @@ any time."
(setf (documentation '*current-thread* 'variable)
"Bound in each thread to the thread itself.")
+#+bitpacked-mutex
+(progn (defmacro mutex-%owner (mu) `(owner-tid-from-word (mutex-%state ,mu)))
+ (defmacro owner-tid-from-word (word) `(ash ,word -32)))
+
(defun mutex-value (mutex)
"Current owner of the mutex, NIL if the mutex is free. May return a
stale value, use MUTEX-OWNER instead."
@@ -46,16 +50,20 @@ stale value, use MUTEX-OWNER instead."
;;; representation so that on 32-bit builds we never cons when reading the slot.
;;; I'm not sure where consing was happening, but it did, which caused
;;; failure of the (:no-consing :mutex) test.
+#-bitpacked-mutex
+(progn
(defmacro current-vmthread-id ()
'(sb-ext:truly-the fixnum (%make-lisp-obj (current-thread-sap-int))))
(defmacro vmthread-id->addr (x) `(get-lisp-obj-address ,x))
+)
(declaim (inline holding-mutex-p))
(defun holding-mutex-p (mutex)
"Test whether the current thread is holding MUTEX."
;; This is about the only use for which a stale value of owner is
;; sufficient.
- (= (mutex-%owner mutex) (current-vmthread-id)))
+ (= (mutex-%owner mutex) #+bitpacked-mutex (thread-os-tid *current-thread*)
+ #-bitpacked-mutex (current-vmthread-id)))
(defun mutex-owner (mutex)
"Current owner of the mutex, NIL if the mutex is free. Naturally,
@@ -65,10 +73,12 @@ testing whether the current thread is holding a mutex see
HOLDING-MUTEX-P."
;; Make sure to get the current value.
(barrier (:read))
- (let ((vmthread (mutex-%owner mutex)))
- (cond ((= vmthread (current-vmthread-id)) *current-thread*)
- ((= vmthread 0) nil)
- (t (mutex-owner-lookup vmthread)))))
+ (let ((self #+bitpacked-mutex (thread-os-tid *current-thread*)
+ #-bitpacked-mutex (current-vmthread-id))
+ (owner (mutex-%owner mutex)))
+ (cond ((= owner self) *current-thread*)
+ ((= owner 0) nil)
+ (t (mutex-owner-lookup owner)))))
(defsetf mutex-value set-mutex-value)
diff --git a/src/cold/shared.lisp b/src/cold/shared.lisp
index b30b4cffd..df57a6fed 100644
--- a/src/cold/shared.lisp
+++ b/src/cold/shared.lisp
@@ -309,6 +309,8 @@
;; all versions that support arm, so always enable them there
(when (target-featurep '(:and :sb-thread (:or :linux :freebsd :openbsd (:and :darwin :arm64))))
(pushnew :sb-futex sb-xc:*features*))
+ (when (target-featurep '(:and :64-bit :sb-futex :little-endian))
+ (pushnew :bitpacked-mutex sb-xc:*features*))
(when (target-featurep '(:and :sb-thread (:or :arm64 :x86-64)))
(pushnew :system-tlabs sb-xc:*features*))
(when (target-featurep '(:and (:or :permgen :immobile-space) :x86-64))
diff --git a/tests/futex-wait.test.sh b/tests/futex-wait.test.sh
index 231487404..20b07b5f9 100755
--- a/tests/futex-wait.test.sh
+++ b/tests/futex-wait.test.sh
@@ -33,6 +33,10 @@ strace -f -e futex -e signal=\!sigsegv -o $tracelog \
(sb-thread:grab-mutex *m*)
+;; I don't know whether this test is actually valid with #+bitpacked-mutex
+;; but it passes with this minor modification.
+(defmacro our-state (m) \`(ldb (byte 32 0) (sb-thread::mutex-%state ,m)))
+
;; We need to simulate some thread observing the mutex in a contended state, while
;; the thread that currently holds it releases and re-grabs it again quickly enough
;; to place it in state 1, not state 2 (but having correctly notified waiters).
@@ -57,7 +61,7 @@ strace -f -e futex -e signal=\!sigsegv -o $tracelog \
;;; Each "spin" on the lock bit would require a system call and return.
(defun test ()
-(setf (sb-thread::mutex-state *m*) 2) ; contended state
+(setf (our-state *m*) 2) ; contended state
(setq *thr*
(sb-thread:make-thread
(lambda ()
@@ -76,18 +80,18 @@ strace -f -e futex -e signal=\!sigsegv -o $tracelog \
;; could execute enough of its retry loop to win the grab. i.e. it's going to sleep
;; again on the futex word, but where it would incorrectly think the mutex is already
;; in state 2 and would not change it, thus failing the match condition in futex_wait.
-(setf (sb-thread::mutex-state *m*) 1)
+(setf (our-state *m*) 1)
(sb-sys:with-pinned-objects (*m*)
(let ((disp
(- (* (+ sb-vm:instance-slots-offset
- (sb-kernel:get-dsd-index sb-thread::mutex sb-thread::state))
+ (sb-kernel:get-dsd-index sb-thread::mutex sb-thread::%state))
sb-vm:n-word-bytes)
sb-vm:instance-pointer-lowtag)))
(sb-thread::futex-wake (+ (sb-kernel:get-lisp-obj-address *m*) disp
#+(and 64-bit big-endian) 4)
1)))
-(format t "~&looks like mutex state is ~d~%" (sb-thread::mutex-state *m*))
+(format t "~&looks like mutex state is ~d~%" (our-state *m*))
(sleep .05) ; let that thread lose for a while
(sb-thread:release-mutex *m*)
(sb-thread:join-thread *thr*))
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL