Posted to tcl by mjanssen at Sat Apr 22 20:15:17 GMT 2017view pretty
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