Posted to tcl by bairui at Thu Apr 27 10:09:11 GMT 2017view pretty
package require Thread set unfinished_work {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19} set finished_work {} set n_workers 7 set is_done false proc get_work {} { puts "Main distributing work from {$::unfinished_work}" set ::unfinished_work [lassign $::unfinished_work work] return $work } proc give_result {result} { puts "Main receiving finished work: $result" lappend ::finished_work $result } proc remove_worker {tid wid} { set status [thread::join $tid] set workers [expr [llength [thread::names]] - 1] puts "Main removing worker $wid with status $status. Remaining number of workers: $workers" if {$workers == 0} { puts "Main retiring -- all workers done" set ::is_done true } } proc start_worker {wid} { set id [thread::create -joinable { proc work {main wid} { set result 0 ;# simulate work-result with incrementing local integer while 1 { puts "Worker $wid asking for work" set work [thread::send $main get_work] if {$work eq ""} break puts "Worker $wid doing work $work" after 1 ;# simulate workload (using value of 1 to speed up multiple iteration tests) thread::send -async $main [list give_result [list $wid $work [incr result]]] } thread::send -async $main [list remove_worker [thread::id] $wid] thread::release } thread::wait }] thread::send -async $id [list work [thread::id] $wid] } for {set wid 0} {$wid < $n_workers} {incr wid} { start_worker $wid } vwait is_done puts "Main results: $finished_work" puts "Main remaining threads: [thread::names]"