I've been looking at implementing more performant locking
then current mutexes for SBCL, but I don't see how to do it
0. Correct and interrupt safe.
1. No syscalls needed when lock is not contended.
2. Supports timeouts.
I have a futex based implementation following the outline
given in the "Futexes Are Tricky" paper, plus some interrupt
handling smarts, but I'm stumped when it comes to lutexes.
To implement the same approach we need a futex_wait workalike,
which terminates immediately if X != MAGIC_CONSTANT on start
of wait -- and I don't see how to do this elegantly: the waiter
would need to check on startup for this, and again every once
and a while (since it may be that it changed after we checked
it but before the wait _really_ started)*, like pthread_futex
implementation now does. I'd rather not go there unless I really
Does someone have a bright idea of how to implement locking
with the above properties on top of lutexoid semaphore with
timeout? Or another route entirely?
WIP code follows, essentially an implementation of the "Mutex 2"
algorith from "Futexes Are Tricky" -- turning this into the more
micro-efficient "Mutex 3" version is easy, just needs implementing
"A synchronization object."
;; Informational: this is nulled out slightly before the lock
;; is released, and assigned after the lock has been grabbed,
;; and is used to detect recursion -- but when looked at from
;; other threads this should be treated with similar skeptisism
;; as THREAD-ALIVE &co.
;; FIXME: DEFCONSTANT these
;; 0 = free
;; 1 = taken, no waiters
;; 2 = taken, one or more threads waiting
(%state 0 :type fixnum))
(declaim (inline lock-owner))
(defun lock-owner (lock)
(declaim (inline lock-recursive-p))
(defun lock-recursive-p (lock)
(defun %lock-sleep (lock timeout)
(zerop (futex-wait (lock-state-address lock)
;; Hardcode 2, meaning locked with sleepers, because
;; we want the FUTEX-WAIT to return without needing
;; a wakeup if the state is different. If we pulled
;; the current LOCK-STATE here we might accidentally
;; get 0 if another thread just released the lock.
(defun recursive-lock-error (lock thread)
(error "Recursive lock attempt on non-recursive lock ~S by ~S."
(defun grab-lock (lock &key timeout)
"Tries to acquire LOCK. Returns T on success, and NIL on failure.
Signals an error if the lock is not recursive, but ia already owned by the
This function should be called while interrupts are disabled:
;; ALLOW-WITH-INTERRUPTS is not necessary, but allows
;; the wait to be interrupted. Similarly for the
;; WITH-LOCAL-INTERRUPTS around the ellipsis body.
(allow-with-interrupts (setf got-it (grab-lock lock)))
Otherwise it is possible for an interrupt to arrive between lock acquisition
and setting the GOT-IT marker. For most purposes WITH-LOCK is recommended
instead of using GRAB-LOCK directly."
;; Need to disable interrupts, since we want to twiddle the owner
;; and state both without the danger of unwinding in between. WITH-LOCK
;; can call %GRAB-LOCK directly..
(%grab-lock lock timeout)))
(defun %grab-lock (lock timeout)
(flet ((maybe-got-it (old)
(when (zerop old)
(setf (lock-%owner lock) self)
(return-from %grab-lock t))))
(let ((self *current-thread*)
(state (compare-and-swap-lock-state lock 0 1)))
;; It is possible that we grab the lock here with state 1
;; after RELEASE-LOCK has woken up a sleeper that just
;; hasn't gotten the lock yet, but that's OK: the previous
;; sleeper is awake now, and will flip state back to 2
;; before going back to sleep.
;; Check recursion.
(when (eq self (lock-owner lock))
(if (lock-recursive-p lock)
(return-from %grab-lock t)
(recursive-thread-error lock self))))
(when (or (eql 2 state)
(not (zerop (compare-and-swap-lock-state lock 1 2))))
;; State is now 2, so we can sleep. %LOCK-SLEEP returns
;; true without needing wakeup if the state has changed
;; before we get there.
(let ((unwind t))
(unless (prog1 (with-local-interrupts
(%lock-sleep lock timeout))
(setf unwind nil))
(return-from %grab-lock nil))
;; If we were interrupted we need to wake another sleeper
;; if the lock is free: it is possible that the interrupt
;; hit us right after we were woken up ourselves.
;; FIXME: CAS is overkill here, but we do want a barrier,
;; I believe.
(when (and unwind (zerop (compare-and-swap-lock-state lock 0 0)))
(%lock-wake lock 1)))))
;; Either we were woken up, or we never went to sleep in
;; the first place because the lock was freed between our
;; initial attempt and the time we tried to mark it as
;; having sleepers.
;; Here we don't know if there are other sleepers or not,
;; so we must transition to 2!
(setf state (compare-and-swap-lock-state lock 0 2))
(defun release-lock (lock &key force)
"Releases LOCK. Returns NIL. Signals an error if current thread is not the
owner of the lock unless FORCE is true."
(unless (or force (eq *current-thread* (lock-owner lock)))
(error "Attempt to release ~S by ~S when not owner."
;; Need to twiddle both owner and state -- can't have interrupts.
;; WITH-LOCK can call %RELEASE-LOCK directly.
(defun %release-lock (lock)
;; Nuke owner information.
(setf (lock-%owner lock) nil)
(let ((state (compare-and-swap-lock-state lock 1 0)))
(when (eql state 2)
;; Waiters. Release lock and wake up.
(aver (eql 2 (compare-and-swap-lock-state lock 2 0)))
(%lock-wake lock 1))))