Skip to content

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.

8 Comments

  1. Here is an example that uses neither threads, nor a continuation lib. The stack is tracked explicitly.

    Monday, November 22, 2010 at 12:04 pm | Permalink
  2. Matt Swank wrote:

    Well, I meant to put the URI in the message…
    http://paste.lisp.org/display/116913

    Monday, November 22, 2010 at 3:20 pm | Permalink
  3. Hmm… I’m going to have to look at Matt’s code more closely. I was expecting it to take a thread, a lock, and a condition variable. I will have to see if I can pull it off with just one CV. Of course, Matt already beat me by over 1000%, eh? :)

    Tuesday, November 23, 2010 at 1:49 am | Permalink
  4. ryan wrote:

    @Matt: that looks neat, I’ll play more this weekend. On first glance, it looks like you can only continue forms passed to the yield; so (yield 3) (yield 4) would have to be written as (yield 3 (yield 4)).

    Tuesday, November 23, 2010 at 10:49 am | Permalink
  5. Matt Swank wrote:

    @ryan I’m not sure what you mean. Yield takes multiple arguments so I think you want (yield 3 4).
    That returns 3, and pushes a continuation to return 4 on the next iteration.

    The nice thing is that you can program in a reasonably direct style until you want to yield.

    Tuesday, November 23, 2010 at 6:13 pm | Permalink
  6. Chaireeinfert wrote:

    растаможить груз

    Wednesday, May 16, 2012 at 12:09 pm | Permalink
  7. Hurrah! At last I got a webpage from where I be
    able to really take useful data regarding my study
    and knowledge.

    Tuesday, January 22, 2013 at 1:33 am | Permalink
  8. Gene wrote:

    It’s perfect time to make a few plans for the future and it’s time to be happy.
    I’ve learn this put up and if I may just I want to recommend you some fascinating issues or advice. Maybe you can write subsequent articles referring to this article. I desire to learn even more issues about it!

    Tuesday, April 23, 2013 at 8:49 am | Permalink