Bordeaux Threads Questions

Hey.
I'm working through the concurrency chapter in Lisp Outside the Box found here. I'm using Bordeaux threads instead of Allegro CL.

(defvar *k0* nil)
(setf *k0* (bt:make-thread ;; capture returned thread object
                 (lambda()
                   (unwind-protect (loop)
                     (print "Goodbye" #.*standard-output*))) :name "Say goodbye"))

What is the purpose of the sharp-dot read macro here; I know that it's returning the *standard-output* object at read time, I just don't get why/how it's being done?

Also in the given example for an event loop:

(defun improved-event-loop () ;; ACL code, not Bordeaux threads!
    (loop
       (process-wait "Waiting for something to happen" 'something-has-happened)
       (act-on-that-thing)))

Is there a way to get equivalent behavior with Bordeaux threads despite the absence of thread-wait in its API? Thanks.

For your second question, you want BORDEAUX-THREADS:JOIN-THREAD.

On the first question, obviously it is so as to use a "useful" (for some definition of useful) value.

I'm a bit puzzled myself for the exact reason, I think it could be one of two things:

For REPL input, slime binds *STANDARD-OUTPUT* to a stream that sends output to the REPL on the emacs side, something you may notice if you try to TRACE a function that is called by a hunchentoot handler is that the output is NOT passed to the REPL, instead it gets sent to the *inferior-lisp" buffer (unless you tell slime to globally-redirect-io).

My second possibile answer is due to the difference between how global variables in C etc, and special variables in common-lisp work:

In C/C++ global variables, and java/c# static variables at any given time there is only a single value, you can only read it, or mutate it.

When you DEFVAR a special variable you give it a value, and you can SETF it to change it. So far, so boring. Where it becomes more interesting is when you use LET to temporarily bind a new value to the special.

In a lisp without threads you could save the old value, SETF it to the new value, and then when the LET goes out of scope, you can SETF the value back to the saved value.

This doesn't work very well in a threaded lisp though, because with two threads that bind the same special, you would have a very timing sensitive non-determinism on what the value was when the two threads were finished. So threaded lisps use a traditional global variable for the root binding of a special which can be SETF'd and is shared by current and future threads, but when you use LET to rebind it, the binding is thread-local.

On further thought, for the second possibility, while what I said is true, it doesn't apply in this particular case, so I think it is probably the first possibility (or something more exotic).

For the process-wait, seems to me, are condition variables more appropriate than a simple join-thread.

(defparameter *lock* (bt:make-lock))
(defparameter *cv* (bt:make-condition-variable))
(defparmeter place ())

(defun try-with-lock-held (place)
    (bt:make-thread (lambda()
                       (bt:with-lock-held (*lock*) ;; should acquire AND release lock?
                         (setf place "done")
                         (bt:condition-notify *cv*))) :name "with-lock-held")) ==>TRY-WITH-LOCK-HELD

(try-with-lock-held place)

place ==> nil

Before I try condtion-wait , what am I doing wrong here?

Functions have own scope, it's the same thing like:

(let ((place place))
  (setf place "done"))

For a better comprehension, try:

(defun try-with-lock-held (place)
  (setf place "done"))

I think, a light introduction would not hurt.

(defparameter *lock* (bt:make-lock))
(defparameter *cv* (bt:make-condition-variable))
(defparameter *place* ())

(defun try-with-lock-held ()
    (bt:make-thread (lambda()
                       (bt:with-lock-held (*lock*) ;; 
                         (setf *place* "done")
                         (bt:condition-notify *cv*))) :name "with-lock-held")) ==>TRY-WITH-LOCK-HELD

(try-with-lock-held)

*place* ==> "done"

Done in by scope...(smh). Thanks!

A couple more questions (please see code below):

;; is this a correct way for this?

(defun test() ;; Is the general pattern to use a defun? Couldn't you use the lambda body in the thunk in make-thread just as well?
    (bt:with-lock-held (lock)
        (do-stuff)
        (do-more-stuff)
        (bt:condition-wait  cv lock))) ;; Should the call to condition-wait be within the body of with-lock-held or not?

Also, could someone please tell me where the output is going when I do this?

(defvar *k0* nil)
(setf *k0* (bt:make-thread ;; capture returned thread object
                 (lambda()
                   (unwind-protect (loop) ;;
                     (print "Goodbye"))) :name "Say goodbye")) ;; With or without  the #.*standard-output*, I get no output... prints fine without a loop.

Hopefully it isn't a SBCL thing. Thanks.

macrolyte wrote:A couple more questions (please see code below):

;; is this a correct way for this?

(defun test() ;; Is the general pattern to use a defun? Couldn't you use the lambda body in the thunk in make-thread just as well?
    (bt:with-lock-held (lock)
        (do-stuff)
        (do-more-stuff)
        (bt:condition-wait  cv lock))) ;; Should the call to condition-wait be within the body of with-lock-held or not?

The order of bt:condition-wait and do-stuff seems to be reversed, one usually waits on a condition variable being signalled before doing something about it.

macrolyte wrote:Also, could someone please tell me where the output is going when I do this?

(defvar *k0* nil)
(setf *k0* (bt:make-thread ;; capture returned thread object
                 (lambda()
                   (unwind-protect (loop) ;;
                     (print "Goodbye"))) :name "Say goodbye")) ;; With or without  the #.*standard-output*, I get no output... prints fine without a loop.

Hopefully it isn't a SBCL thing. Thanks.

The code as it stands here above does not produce any output, at least not yet. The form (loop) being the degenerate version of the simple variant of the cl:loop macro it denotes an infinitely busy empty loop that does nothing more than waste CPU cycles very quickly and for ever. (In C you could write it as "for (;;);" or as "while (1);")
So the thread you thus created spins without any output until something kicks it out of its merry looping. And that was the reason for the process-kill form wrapped around the original piece of code you took from "Lisp Outside the Box". In Allegro CL, AFAICT, the function process-kill when applied to a thread will interrupt its execution, force it to unwind its call stack and bring it to a state of terminal inactivity. It is during the unwinding of the thread's call stack that 'Goodbye' will end up printed on a stream.

In Bordeaux Threads you may try to use bt:destroy-thread on your *k0* thread to achieve the same result but beware that its specification clearly states that it is implementation-defined whether the thus targetted thread will have its call stack unwound or not. On SBCL it happens to be the case. On other implementations you may try to use (bt:interrupt-thread *k0* #'(lambda () (abort)) instead in order to force the thread's call stack unwinding that you expect.

But there is still that question of where is 'Goodbye' printed and, mainly, why there.

Thanks jcbeaudoin, I thought that might be the case... anyways here is what I have done so far:

(defparameter *test−lock* (bt:make−lock))
(defparameter *test−cond* (bt:make−condition−variable))
(defparameter *queue* ())
(defparameter *lock0* (bt:make−lock))
(defparameter *cv* (bt:make−condition−variable))
(defparameter *lock* (bt:make−lock))

(defun receive−condition−variable (message)
    (bt:with−lock−held (*lock0*)     ;; work first then wait...
        (push message *queue*))
    (bt:with−lock−held(*test−lock*)
        (bt:condition−wait *test−cond* *test−lock*)))

(defun send−condition−variable (message)
    (bt:with−lock−held (*test−lock*)
        (push message *queue*))
    (bt:condition−notify *test−cond*))

(setf ef0 (bt:make−thread (lambda()(receive−condition−variable "lover")) :name "rcv−cond−var"))

*queue*    ==> "lover"
ef0        ==>#<SB-THREAD:THREAD "rcv-cond-var" RUNNING {24AC7009}>

(setf ff0 (bt:make−thread (lambda()(send−condition−variable "star")) :name "snd−cond−var"))

*queue*    ==> ("star" "lover")
ff0        ==> #<SB-THREAD:THREAD "snd-cond-var" FINISHED values: 0 {23F076E9}>
efo        ==> #<SB-THREAD:THREAD "rcv-cond-var" FINISHED values: T {23E48941}>

(defun rcv−reversed (message)          ;; wait first then work
   (bt:with−lock−held (*test−lock*)
       (bt:condition−wait *test−cond* *test−lock*))
    (bt:with−lock−held (*lock0*)
        (push message *queue*)))

(setf gf0 (bt:make−thread (lambda()(rcv−reversed "shooting")) :name "rcv−reversed"))

gf0     ==> #<SB-THREAD: THREAD "rcv-reversed" RUNNING {24297A71}>
*queue* ==>("star" "lover")

(setf ff0 (bt:make−thread (lambda()(send−condition−variable "star")) :name "snd−cond−var"))

ff0         ==> #<SB-THREAD:THREAD "snd-cond-var" FINISHED values: 0 {244AF431}>
gf0         ==> #<SB-THREAD: THREAD "rcv-reversed" FINISHED values: ("shooting" "star" "star" "lover") {24297A1}>
*queue*     ==> ("shooting" "star" "star" "lover")

(defun loop−rcv−rev (message)         ;; continuous loop- work when notified  
    (loop
        (bt:with−lock−held (*test−lock*)
            (bt:condition−wait *test−cond* *test−lock*))
        (bt:with−lock−held (*lock*)
            (push message *queue*))))

(setf hf0 (bt:make−thread (lambda()(loop−rcv−rev "twinkle")) :name "loop−rcv−rev"))

hf0       ==> #<SB-THREAD: THREAD "loop-rcv-rev" RUNNING {24BD03D1}>
*queue*   ==> ("shooting" "star" "star" "lover")

(setf ff0 (bt:make−thread (lambda()(send−condition−variable "star")) :name "snd−cond−var"))

hf0         ==> #<SB-THREAD: THREAD "loop-rcv-rev" RUNNING {24BD03D1}>
ff0         ==> #<SB-THREAD: THREAD "snd-cond-var" FINISHED values: 0 {23E1E9C9}>
*queue*     ==> ("twinkle" "star" "shooting" "star" "star" "lover")

(defun count−down(n)   ;; dummy function
    (let((i n)(j 0))
        (loop while (>= i j) do
        (print i)
        (sleep 1)
        (decf i)))
    n)

(defun create−new−thread()
    (bt:with−lock−held (*lock0*)
        (bt:make−thread (lambda()(count−down 20)) :name "create−new−thread"))
    (bt:condition−notify *test−cond*))

(defun test−cnt(message)
    (bt:with−lock−held (*test−lock*)
        (loop while (not (= 0 (create−new−thread))) do            ;; Is zero an exit code???
            (bt:condition−wait *test−cond* *test−lock*))
    (push message *queue*)))

(setf if0 (bt:make−thread (lambda()(test−cnt "star")) :name "test−cnt"))

if0          ==> #<SB-THREAD:THREAD "test-cnt" FINISHED values: ("star") {25876E19}>
*queue*      ==>("twinkle" "star" "twinkle" "star" "shooting" "star" "star" "lover")

This is what I have so far. The last function (test-cnt) I'm not so sure about. It seems to be working correctly but I could be wrong especially in light of the loop predicate. Any help or suggestions are welcome. Thanks.

SB-CONCURRENCY has mailboxes, which appear to do what you are intending.

pjstirling wrote:SB-CONCURRENCY has mailboxes, which appear to do what you are intending.

REALLY??!! I'll take a look now. Thanks!

SB-CONCURRENCY is from SBCL, I would take a look at http://cliki.net/concurrency for the multiplatform solution. I can't recommend any of those libraries I don't know them, but there should be a library for your purposes (which I don't know either).