coroutines in common lisp with bordeaux-threads
Turns out threads are a lot easier without beer and after a good nights sleep. Following up on last night’s defeat (see coroutines in common lisp), I re-read the documentation this morning and got my locks sorted out.
I now use one lock and two condition variables (CV). From the bordeaux-threads API docs:
A condition variable provides a mechanism for threads to put themselves to sleep while waiting for the state of something to change, then to be subsequently woken by another thread which has changed the state.
I thought of these CVs like events in Java/C#/Javascript. Telling one thread to CONDITION-WAIT on a CV is kinda like telling it to listen to that event, and have another thread CONDITION-NOTIFY on a CV is kinda like firing the event. It took me a long time to understand the importance of CONDITION-WAIT atomically releasing a lock, and reacquiring it before continuing execution in that thread. That mechanism let me coordinate some sequential execution between the threads, eliminating the race conditions that beat me last night.
I also added the ability to send a value into the coroutine by setting the return value of yield.
I used one CV to tell the coroutine it should run to the next yield, and another CV for the coroutine to tell the caller that a value was ready for it. I had a few let bindings for my shared memory, closing variables into both the coroutine and caller functions. The coroutine doesn’t spawn a new thread until the first time it’s funcalled. I have a somewhat poor mechanism for determining if the coroutine is done; you specify a sigil value and the coroutine yields that as the final value (kind of like eof-value in stream reading functions). I tried to use thread-alive-p, but ran into race conditions. I have a few ideas for how to improve that.
Here’s the latest make-coroutine macro and test function:
(defmacro make-coroutine ((&key (coroutine-done-value :done))
&body body)
(alexandria:with-gensyms ((yield-cv "there a value ready for pickup")
(run-cv "coroutine should run")
(lock "lock")
(val "shared memory")
(yield-result "return value of yield in the corouting")
(thrfn "thread function body"))
`(let* ((,yield-cv (bordeaux-threads:make-condition-variable
:name "yield"))
(,run-cv (bordeaux-threads:make-condition-variable
:name "run"))
(,lock (bordeaux-threads:make-lock "coroutine lock"))
,val ,yield-result
(,thrfn (lambda ()
(flet ((yield (&optional n)
(setf ,val n)
;;signal that a value is ready for pickup
(bordeaux-threads:condition-notify ,yield-cv)
;;wait for a chance to run
(bordeaux-threads:condition-wait ,run-cv ,lock)
,yield-result))
(bordeaux-threads:acquire-lock ,lock)
,@body
(yield ,coroutine-done-value)
(bordeaux-threads:release-lock ,lock)))))
;;function to pull values from the coroutine
(let ((alive-p T) thr)
(lambda (&key (send nil send-suppliedp))
(when alive-p
(bordeaux-threads:with-lock-held (,lock)
(if thr
(bordeaux-threads:condition-notify ,run-cv)
(setf thr (bordeaux-threads:make-thread
,thrfn :name "coroutine")))
(bordeaux-threads:condition-wait ,yield-cv ,lock)
(setf ,yield-result
(if send-suppliedp send ,val))
(when (eql ,coroutine-done-value ,val)
(setf alive-p nil)
(bordeaux-threads:condition-notify ,run-cv))
))
,val)))))
(defun coroutine-test ()
(let ((cor (make-coroutine (:coroutine-done-value :done)
(yield 1)
(yield)
(yield 4)))
(cor2 (make-coroutine ()
(yield (yield (yield 4)))
)))
(assert (eql 1 (funcall cor)) )
(assert (null (funcall cor)))
(assert (eql 4 (funcall cor)))
(assert (eql :done (funcall cor)))
(assert (eql :done (funcall cor)))
(assert (eql 4 (funcall cor2)))
(assert (eql 4 (funcall cor2 :send 6)))
(assert (eql 6 (funcall cor2)))
(assert (eql :done (funcall cor2)))))
I’ll probably play with it more tonight, maybe put together a stand-alone repo / library.
