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]"