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