Posted to tcl by mjanssen at Sat Apr 22 20:15:17 GMT 2017view raw

  1. package require Thread
  2.  
  3. set allwork {1 2 3 4 5 6 7}
  4.  
  5. proc getwork {} {
  6. puts "[thread::id] distributing work from {$::allwork}"
  7. set ::allwork [lassign $::allwork work]
  8. return $work
  9. }
  10.  
  11. proc remove_worker {tid} {
  12. set ::workers [lsearch -all -inline -not $::workers $tid]
  13. if {[llength $::workers] == 0} {
  14. puts "[thread::id] All workers done, exiting"
  15. set ::workers_done 1
  16. }
  17. }
  18.  
  19. proc start_worker {main} {
  20. set id [thread::create {
  21. proc start tid {
  22. while 1 {
  23. puts "[thread::id]: Asking for work"
  24. set work [thread::send $tid getwork]
  25. if {$work ne {}} {
  26. puts "[thread::id]: Doing work $work"
  27. after 1000
  28. } else {
  29. puts "[thread::id]: No more work"
  30. thread::send $tid [list remove_worker [thread::id]]
  31. thread::exit
  32. }
  33. }
  34. }
  35. vwait forever
  36. }]
  37. thread::send -async $id [list start $main]
  38. lappend ::workers $id
  39. }
  40. # start n workers
  41. time [list start_worker [thread::id]] 7
  42.  
  43. vwait workers_done