How to use SBCL by providing a semaphore against race conditions

Question

As far as I know about semaphores, a semaphore is used to protect resources that can be counted and are vulnerable to race conditions. But when reading the SBCL documentation of semaphores, I could not figure out how to correctly use the provided semaphore implementation to protect the resource.

A normal workflow, as I recall, would be as follows:

• a process wants to get part from a semaphore protected by data (for example, this is a trivial queue). Since the semaphore counter is 0, the process is waiting

• another process puts something in the queue, and since the semaphore is incremented, the signal is sent to all waiting processes.

Given the possibility of alternation, you need to protect any of these resources, since they may not be in this order or in any linear order in general. Therefore, for example, Java interprets each class as an implicit monitor and provides the syncronized keyword, with which the programmer can define a protected area that can be accessed only one process at a time.

How I emulate this functionality in general is lisp, since I am sure that my current code is both thread safe and without a semaphore, since the semaphore does not know which code to protect.

 ;;the package (defpackage :tests (:use :cl :sb-thread)) (in-package :tests) (defclass thread-queue () ((semaphore :initform (make-semaphore :name "thread-queue-semaphore")) (in-stack :initform nil) (out-stack :initform nil))) (defgeneric enqueue-* (queue element) (:documentation "adds an element to the queue")) (defgeneric dequeue-* (queue &key timeout) (:documentation "removes and returns the first element to get out")) (defmethod enqueue-* ((queue thread-queue) element) (signal-semaphore (slot-value queue 'semaphore)) (setf (slot-value queue 'in-stack) (push element (slot-value queue 'in-stack)))) (defmethod dequeue-* ((queue thread-queue) &key timeout) (wait-on-semaphore (slot-value queue 'semaphore) :timeout timeout) (when (= (length (slot-value queue 'out-stack)) 0) (setf (slot-value queue 'out-stack) (reverse (slot-value queue 'in-stack))) (setf (slot-value queue 'in-stack) nil)) (let ((first (car (slot-value queue 'out-stack)))) (setf (slot-value queue 'out-stack) (cdr (slot-value queue 'out-stack))) first)) (defparameter *test* (make-instance 'thread-queue)) (dequeue-* *test* :timeout 5) (enqueue-* *test* 42) (enqueue-* *test* 41) (enqueue-* *test* 40) (dequeue-* *test* :timeout 5) (dequeue-* *test* :timeout 5) (dequeue-* *test* :timeout 5) (dequeue-* *test* :timeout 5) 

Answer 1

You already have the semaphore count = 0 on which users are waiting.

You will also need an exclusive lock on access to your stacks (possibly one for each) or, alternatively, no lock. If you want / should use semaphores, the binary semaphore can serve as an exclusive lock.

---

EDIT: In SBCL, you already have queueless locks , you can use one of them instead of two stacks. Another possibility is to use atomic operations .

Finally, if that doesn't suit you yet, use mutex , a packaging code that allows and updates the stacks inside with-mutex or with-recursive-lock .

Be sure to use the lock / mutex after waking up from the semaphore, and not around waiting for the semaphore, otherwise you will lose the advantage that semaphores give you, which is the ability to wake up several waiters in a row, and not one at a time.

You can read all about these things in the SBCL manual.

In addition, I think that some work has been done to rename every blocking thing in SBCL to lock , according to this blog post , but I do not know its status, and it claims that the old names will be maintained for some time.

---

You will probably need the count = limit semaphore for producers so as not to exceed the limit of your queue.

In enqueue-* you should signal the semaphore after , updating the queue. setf not required, push already saves the new chapter of the list in place.

In your dequeue-* , length is a long function applied to lists, but checking that the list is empty is cheaper with null or endp . Instead of taking car and storing cdr , you can use pop , it does just that.

Answer 2

You need to have a mutual exclusion semaphore (aka mutex) for the duration of your operations with the queue. Use the SBCL mutex as such:

 (defclass thread-queue () ((lock :initform (sb-thread:make-mutex :name 'thread-queue-lock)) ...)) (defmethod enqueue-* ((queue thread-queue) element) (sb-thread:with-recursive-lock ((slot-value queue 'lock)) (setf (slot-value queue 'in-stack) (push element (slot-value queue 'in-stack))))) * (defvar lock (sb-thread:make-mutex)) LOCK * lock #S(SB-THREAD:MUTEX :NAME NIL :%OWNER NIL :LUTEX #<unknown pointer object, widetag=#x5E {11CEB15F}>) * (sb-thread:with-recursive-lock (lock) 'foo) FOO * (sb-thread:with-recursive-lock (lock) (sb-thread:with-recursive-lock (lock) 'foo)) FOO 

Presumably the with-recursive-lock macro will do the right thing (unlock the lock using unwind-protect or some) to exit non-locally.

This is the equivalent of Java synchronized - the above protects the enqueue-* method; you need to do this with any other method that can be called asynchronous.