[Openmcl-devel] Semaphore troubles

[Gary Byers]

On Tue, 8 May 2012, James M. Lawrence wrote:

> Is there anything incorrect about the code below?

I don't know.  I'd have to put more effort into it than I have (or
than I likely will) to have any idea of what it's doing and I don't
(at this point) have any motivation to try.  Perhaps someone else -
likely a better human being than I am - wants to make more of an effort
than I do.  Good luck!

That said ...

- a lot of code in CCL depends on things like locks and semaphores
   working correctly and that code seems to work as expected; if it
   didn't, the symptoms would very likely be very noticeable.  I suppose
   that it's possible that your code exposes a problem somewhere that
   nothing else does, but that doesn't seem likely.

- CCL doesn't really provide condition variables as such; treating the
   combination of a semaphore and a lock as a sort of low-rent condition
   variable probably can't work reliably.  (As you note below, things like
   pthread_cond_wait() have to do things to enforce atomicity, and those
   things typically have to be done at a very low level.)



> The function `test'
> eventually fails at the first assertion, with `result' being `later'
> rather than `sooner'. On my system (Linux Core-i7) the failure occurs
> within 100 iterations.

If you have some reason to think that this has something to do with CCL,
that would be interesting.  It's not clear to me what you think this has
to do with CCL.

>
> The condition-wait function, which has been lifted directly from
> bordeaux-threads, looks suspicious. What if ccl:signal-semaphore is
> called during the time interval between the calls to ccl:release-lock
> and ccl:wait-on-semaphore?
>
> I don't see any CCL functions which take a semaphore and a lock. I
> suppose I don't understand the CCL thread model? What is the proper
> way to construct a blocking queue? Thanks in advance.

Like most people, I'm sometimes a little  skeptical that answering a question
like this involves doing a homework assignment for someone, and like most
people I don't like to do that (unless large amounts of cash are involved.)

One simple way to create a blocking queue with just a lock and a semaphore
is:

(defstruct queue
  (innards (%make-queue-data-structure))
  (lock (make-lock))
  (semaphore (make-semaphore)))

What I'm calling INNARDS isn't described here; it's some sort of data structure
that implements first-in, first-out behavior and supports operations ADD-TO
and REMOVE-FROM (not shown here.)  ADD-TO and REMOVE-FROM can only be called
from a thread which holds the queue's lock.  Given this:

(defun produce (object queue)
   (with-lock-grabbed ((queue-lock queue))
     (add-to (queue-innards queue) object)
     (signal-semaphore (queue-semaphore queue))))

(defun consume (queue)
   (wait-on-semaphore (queue-semaphore queue))
   (with-lock-grabbed ((queue-lock queue))
     (remove-from (queue-innards queue)))))


I'm intentionally ignoring an important issue in order to try to make
the point that this can be both conceptually simple and straigtforward
to implement.  (Dealing with the important issue is left as an
exercise; the issue has to do with what happens if a thread running
PRODUCE is interrupted by PROCESS-INTERRUPT between the time the
object is added and the time the semaphore is raised, and similarly if
CONSUME is interrupted between the time that the semaphore is lowered
and the time that the object is removed.  Depending on how the
primitives that actually implement the queue are implemented, they may
also need to ensure that things are executed without ... um, without
interrupts.  There are other issues: it's safe to move the SIGNAL-SEMAPHORE
call in produce out of the WITH-LOCK-GRABBED form, and the effect this
has on latency is worth exploring, but I digress: this all strikes me as
being pretty standard stuff, and using locks and semaphores in CCL seems
to me to be pretty simple (though the devil may be in the details.)


>
> (I wrote a smaller test case without the queue, but I couldn't
> reproduce the problem with it.)


Implementing a stack (last-in, first-out) as a list in Lisp is trivial.
If your code is changed to maintain a stack internally, then:

  - if that works, you probably want to look at your queue implementation;
    the problem may have nothing to do with locking/synchronization at all.

  - if that fails. then the problem is either in CCL's lock- and semaphore-
    related primitives or in your code's use of them.  If you find evidence
    of a problem with those primitives I'd certainly be interested in it,
    but in the absence of such evidence I'm frankly skeptical that such
    a problem exists.

>
> ccl-1.8/lx86cl, md5 040409ba578edfa8b3dd62b009d57929
>
> (defun condition-wait (cvar lock)
>  (unwind-protect
>       (progn
>         (ccl:release-lock lock)
>         (ccl:wait-on-semaphore cvar))
>    (ccl:grab-lock lock)))
>
> ;;; raw-queue
>
> (defun make-raw-queue ()
>  (cons nil nil))
>
> (defun push-raw-queue (value q)
>  (let ((new (cons value nil)))
>    (if (car q)
>        (setf (cddr q) new)
>        (setf (car  q) new))
>    (setf (cdr q) new)))
>
> (defun pop-raw-queue (q)
>  (if (car q)
>      (multiple-value-prog1 (values (caar q) t)
>        (unless (setf (car q) (cdar q))
>          ;; clear lingering ref
>          (setf (cdr q) nil)))
>      (values nil nil)))
>
> ;;; queue
>
> (defstruct queue
>  (impl (make-raw-queue))
>  (lock (ccl:make-lock))
>  (cvar (ccl:make-semaphore)))
>
> (defun push-queue (object queue)
>  (ccl:with-lock-grabbed ((queue-lock queue))
>    (push-raw-queue object (queue-impl queue))
>    (ccl:signal-semaphore (queue-cvar queue))))
>
> (defun pop-queue (queue)
>  (ccl:with-lock-grabbed ((queue-lock queue))
>    (loop (multiple-value-bind (value presentp)
>              (pop-raw-queue (queue-impl queue))
>            (if presentp
>                (return value)
>                (condition-wait (queue-cvar queue)
>                                (queue-lock queue)))))))
>
> ;;; run
>
> (defun test ()
>  (let ((tasks (make-queue)))
>    (loop
>       :repeat 2
>       :do (ccl:process-run-function
>            "test"
>            (lambda ()
>              (loop (funcall (or (pop-queue tasks)
>                                 (return)))))))
>    (let ((receiver (make-queue)))
>      (push-queue (lambda ()
>                    (push-queue (progn (sleep 0.2) 'later)
>                                receiver))
>                  tasks)
>      (push-queue (lambda ()
>                    (push-queue 'sooner receiver))
>                  tasks)
>      (let ((result (pop-queue receiver)))
>        (assert (eq 'sooner result)))
>      (let ((result (pop-queue receiver)))
>        (assert (eq 'later result))))
>    (push-queue nil tasks)
>    (push-queue nil tasks))
>  (format t "."))
>
> (defun run ()
>  (loop (test)))
> _______________________________________________
> Openmcl-devel mailing list
> Openmcl-devel at clozure.com
> http://clozure.com/mailman/listinfo/openmcl-devel
>
>