Posted to tcl by bairui at Thu Apr 27 02:01:43 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 workers         {}
set retirees        {}
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 {wid tid} {
  lappend ::retirees [list $wid $tid]
  puts "Main removing worker $wid. Remaining number of workers: [expr $::n_workers - [llength $::retirees]]"
  if {[llength $::retirees] == $::n_workers} {
    puts "Main retiring -- all workers done"
    set ::is_done true
  }
}

proc start_worker {main wid} {
  set id [thread::create {
      proc start {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 ne {}} {
            puts "Worker $wid doing work $work"
            after 1 ;# simulate workload (using value of 1 to speed up multiple iteration tests)
            thread::send $main [list give_result [list $wid $work [incr result]]]
          } else {
            puts "Worker $wid has no more work"
            if {[thread::exists $main]} {
              thread::send $main [list remove_worker $wid [thread::id]]
              break
            }
          }
        }
      }
      thread::wait
    }]
  thread::send -async $id [list start $main $wid]
  lappend ::workers $id   ;# not directly used in this example but probably useful in serious thread code
}

for {set wid 0} {$wid < $n_workers} {incr wid} {
  start_worker [thread::id] $wid
}

vwait is_done

puts "Main results: $finished_work"

foreach w $retirees {
  lassign $w wid tid
  puts "Main releasing worker $wid"
  thread::release $tid
  after 1 ;# seems to be necessary to prevent main exiting before worker threads have all finished calling remove_worker
}