Re: Bordeaux Threads Questions
Posted: Tue Jun 10, 2014 5:47 pm
Thanks jcbeaudoin, I thought that might be the case... anyways here is what I have done so far:
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.
Code: Select all
(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")