Posted to tcl by apn at Thu Apr 27 02:24:43 GMT 2017view raw

  1. package require Thread
  2.  
  3. set unfinished_work {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19}
  4. set finished_work {}
  5. set workers {}
  6. set retirees {}
  7. set n_workers 7
  8. set is_done false
  9.  
  10. proc get_work {} {
  11. puts "Main distributing work from {$::unfinished_work}"
  12. set ::unfinished_work [lassign $::unfinished_work work]
  13. return $work
  14. }
  15.  
  16. proc give_result {result} {
  17. puts "Main receiving finished work: $result"
  18. lappend ::finished_work $result
  19. }
  20.  
  21. proc remove_worker {wid tid} {
  22. lappend ::retirees [list $wid $tid]
  23. puts "Main removing worker $wid. Remaining number of workers: [expr $::n_workers - [llength $::retirees]]"
  24. if {[llength $::retirees] == $::n_workers} {
  25. puts "Main retiring -- all workers done"
  26. set ::is_done true
  27. }
  28. }
  29.  
  30. proc start_worker {main wid} {
  31. set id [thread::create {
  32. proc start {main wid} {
  33. set result 0 ;# simulate work-result with incrementing local integer
  34. while 1 {
  35. puts "Worker $wid asking for work"
  36. set work [thread::send $main get_work]
  37. if {$work ne {}} {
  38. puts "Worker $wid doing work $work"
  39. after 1 ;# simulate workload (using value of 1 to speed up multiple iteration tests)
  40. thread::send $main [list give_result [list $wid $work [incr result]]]
  41. } else {
  42. puts "Worker $wid has no more work"
  43. if {[thread::exists $main]} {
  44. thread::send $main [list remove_worker $wid [thread::id]]
  45. break
  46. }
  47. }
  48. }
  49. }
  50. thread::wait
  51. }]
  52. thread::send -async $id [list start $main $wid]
  53. lappend ::workers $id ;# not directly used in this example but probably useful in serious thread code
  54. }
  55.  
  56. for {set wid 0} {$wid < $n_workers} {incr wid} {
  57. start_worker [thread::id] $wid
  58. }
  59.  
  60. vwait is_done
  61.  
  62. puts "Main results: $finished_work"
  63.  
  64. foreach w $retirees {
  65. lassign $w wid tid
  66. puts "Main releasing worker $wid"
  67. thread::release $tid
  68. }
  69.  
  70. while {1} {
  71. if {[llength [thread::names]] == 1} {
  72. break; # Only I am left
  73. }
  74. after 1 ;# seems to be necessary to prevent main exiting before worker threads have all finished calling remove_worker
  75. }
  76.