Posted to tcl by bairui at Thu Apr 27 10:09:11 GMT 2017view raw
- 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]"