[Openmcl-devel] Semaphore troubles

[James M. Lawrence]

I thought my example was straightforward enough, though as I mentioned
I wish it were smaller. Following your suggestion, I have replaced the
queue with a stack. I have also taken out the condition-wait function
copied from bordeaux-threads. My pop function now resembles your
consume function.

The same assertion failure occurs.

I am unable to reproduce it with high debug settings, or with tracing,
or with logging.

The test consists of a pair of worker threads pulling from a task
queue. We push two tasks: one task returns immediately, the other task
sleeps for 0.2 seconds (it can be 0.5 seconds or whatever, it just
takes longer to fail). Since we have two workers, we should always
obtain the result of the sleeping task second. A signal is getting
missed, or something.

Clozure does not pass the stress tests for my library, while other CL
implementations do. I've put much effort into narrowing down this
Clozure-only bug to this test case.

I have found and fixed race conditions in Ruby which persisted for
years. We both know that multi-threaded code can seem OK until poked
in right (wrong?) place.

My first inclination was to point the finger at bordeaux-threads,
which is why I asked about its condition-wait function. It may not
have a race condition since Clozure uses atomic counts (which remember
the signal) instead of condition variables (which don't). However it
is not obvious what happens for arbitrary numbers of threads waiting
and signaling at arbitrary times. I had hoped that someone would
reject the validity of bordeaux's condition-wait.

This is now moot since condition-wait is out of the picture.
Incidentally if bordeaux-threads has a bogus implementation on Clozure
then this is news to me. If not then my original pop-queue should
work, though somewhat roundaboutly as Clozure sees it.

I also wondered if threads were somehow accumulating, causing Clozure
to become overwhelmed, but ccl:all-processes reports the same number
of threads on each iteration.

;;; raw-stack

(defstruct raw-stack
  (data nil))

(defun push-raw-stack (value q)
  (setf (raw-stack-data q) (cons value (raw-stack-data q))))

(defun pop-raw-stack (q)
  (if (raw-stack-data q)
      (multiple-value-prog1 (values (car (raw-stack-data q)) t)
        (setf (raw-stack-data q) (cdr (raw-stack-data q))))
      (values nil nil)))

;;; stack

(defstruct stack
  (impl (make-raw-stack))
  (lock (ccl:make-lock))
  (sema (ccl:make-semaphore)))

(defun push-stack (object stack)
  (ccl:with-lock-grabbed ((stack-lock stack))
    (push-raw-stack object (stack-impl stack))
    (ccl:signal-semaphore (stack-sema stack))))

(defun pop-stack (stack)
  (ccl:wait-on-semaphore (stack-sema stack))
  (ccl:with-lock-grabbed ((stack-lock stack))
    (multiple-value-bind (value presentp)
        (pop-raw-stack (stack-impl stack))
      (assert presentp)
      value)))

;;; run

(defun test ()
  (let ((tasks (make-stack)))
    (loop
       :repeat 2
       :do (ccl:process-run-function
            "test"
            (lambda ()
              (loop (funcall (or (pop-stack tasks)
                                 (return)))))))
    (let ((receiver (make-stack)))
      (push-stack (lambda ()
                    (push-stack (progn (sleep 0.2) 'later)
                                receiver))
                  tasks)
      (push-stack (lambda ()
                    (push-stack 'sooner receiver))
                  tasks)
      (let ((result (pop-stack receiver)))
        (assert (eq 'sooner result)))
      (let ((result (pop-stack receiver)))
        (assert (eq 'later result))))
    (push-stack nil tasks)
    (push-stack nil tasks))
  (format t "."))

(defun run ()
  (loop (test)))