[Openmcl-devel] Semaphore troubles

[James M. Lawrence]

On Thu, May 10, 2012 at 10:39 AM, James M. Lawrence <llmjjmll at gmail.com> wrote:
> On Thu, May 10, 2012 at 2:10 AM, Gary Byers <gb at clozure.com> wrote:
>>> The upshot of what you're saying is that Clozure cannot reliably
>>> distribute work across threads, while other CL implementations can.
>>
>> [...]
>>
>> Second of all, CCL doesn't "distribute work between threads"; neither
>> does SBCL, nor do recent versions of LispWorks, nor do other lisp
>> implementations that offer native threads.
>
> I was simply referring to the ability to reliably send tasks to a
> worker thread pool and receive a notification for each task
> immediately after it completes. This is exactly the use case I have,
> and it is exactly what the test case asserts.

To give a wider context: this issue arose while testing a library for
parallelism. I don't have any control over what tasks users send to
the worker thread pool. I only wish to ensure that workers stay busy,
and that often requires the user to be notified the moment each task
completes. That is the purpose of the receiver queue in the test case.
"Distributing work" means "workers staying busy" in this context.

I reproduced with latest in SVN

lx86cl, md5 e7d7fb0814d76b99d35596add5069cd8

10 second sleeps, failure after 11 iterations. Running CCL from a
shell (no slime) with --no-init. For reference here is what I ran:

;;; 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))
        (receiver (make-stack)))
    (loop
       :repeat 2
       :do (ccl:process-run-function
            "test"
            (lambda ()
              (loop (push-stack (funcall (or (pop-stack tasks)
                                             (return)))
                                receiver)))))
    (push-stack (lambda () (sleep 10.0) 'later) tasks)
    (push-stack (lambda () 'sooner) 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)))