Posted to tcl by mjanssen at Sat Apr 22 20:15:17 GMT 2017view raw
- package require Thread
- set allwork {1 2 3 4 5 6 7}
- proc getwork {} {
- puts "[thread::id] distributing work from {$::allwork}"
- set ::allwork [lassign $::allwork work]
- return $work
- }
- proc remove_worker {tid} {
- set ::workers [lsearch -all -inline -not $::workers $tid]
- if {[llength $::workers] == 0} {
- puts "[thread::id] All workers done, exiting"
- set ::workers_done 1
- }
- }
- proc start_worker {main} {
- set id [thread::create {
- proc start tid {
- while 1 {
- puts "[thread::id]: Asking for work"
- set work [thread::send $tid getwork]
- if {$work ne {}} {
- puts "[thread::id]: Doing work $work"
- after 1000
- } else {
- puts "[thread::id]: No more work"
- thread::send $tid [list remove_worker [thread::id]]
- thread::exit
- }
- }
- }
- vwait forever
- }]
- thread::send -async $id [list start $main]
- lappend ::workers $id
- }
- # start n workers
- time [list start_worker [thread::id]] 7
- vwait workers_done