Read-Write Lock with writer-preference in Common Lisp

rwlock.lisp

;; https://en.wikipedia.org/wiki/Readers%E2%80%93writers_problem

(defstruct rwlock
  (rlock (bt:make-lock))
  (wlock (bt:make-lock))
  (rtrylock (bt:make-lock))
  (resource (bt:make-lock))
  (rcount 0)
  (wcount 0))

(defun read-lock-begin (rwlock)
  (bt:acquire-lock (rwlock-rtrylock rwlock))
  (bt:acquire-lock (rwlock-rlock rwlock))
  (when (= 1 (incf (rwlock-rcount rwlock)))
    (bt:acquire-lock (rwlock-resource rwlock)))
  (bt:release-lock (rwlock-rlock rwlock))
  (bt:release-lock (rwlock-rtrylock rwlock)))

(defun read-lock-end (rwlock)
  (bt:acquire-lock (rwlock-rlock rwlock))
  (when (= 0 (decf (rwlock-rcount rwlock)))
    (bt:release-lock (rwlock-resource rwlock)))
  (bt:release-lock (rwlock-rlock rwlock)))

(defmacro with-read-lock (rwlock &body body)
  (with-gensyms (rwlock%)
    `(let ((,rwlock% ,rwlock))
       (read-lock-begin ,rwlock%)
       (unwind-protect
            (progn ,@body)
         (read-lock-end ,rwlock%)))))

(defun write-lock-begin (rwlock)
  (bt:acquire-lock (rwlock-wlock rwlock))
  (when (= 1 (incf (rwlock-wcount rwlock)))
    (bt:acquire-lock (rwlock-rtrylock rwlock)))
  (bt:release-lock (rwlock-wlock rwlock))
  (bt:acquire-lock (rwlock-resource rwlock)))

(defun write-lock-end (rwlock)
  (bt:release-lock (rwlock-resource rwlock))
  (bt:acquire-lock (rwlock-wlock rwlock))
  (when (= 0 (decf (rwlock-wcount rwlock)))
    (bt:release-lock (rwlock-rtrylock rwlock)))
  (bt:release-lock (rwlock-wlock rwlock)))

(defmacro with-write-lock (rwlock &body body)
  (with-gensyms (rwlock%)
    `(let ((,rwlock% ,rwlock))
       (write-lock-begin ,rwlock%)
       (unwind-protect
            (progn ,@body)
         (write-lock-end ,rwlock%)))))

Bordeaux-threads cannot release locks acquired by a different thread. So this part in write-lock-end can lead to a race condition:

(when (= 0 (decf (rwlock-wcount rwlock)))
    (bt:release-lock (rwlock-rtrylock rwlock)))

Consider two threads: a STARTING thread and a LEAVING thread. The STARTING thread enters write-lock-begin, while the LEAVING thread enters write-lock-end.

If the STARTING thread rushes to (incf (rwlock-wcount rwlock)) first, the wcount value will be 2.

And when LEAVING thread gets to (= 0 (decf (rwlock-wcount rwlock))), the wcount value will be 1, so the when condition is not satisfied and the rtrylock is not released by the LEAVING thread.

But when the time comes for the STARTING thread to go through write-lock-end, it will not be able to release rtrylock as it is held by another thread.