Posted to tcl by aspect at Thu Apr 27 02:44:29 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 20}
  4. set finished_work {}
  5. set workers {}
  6. set retirees {}
  7. set n_workers 7
  8. set is_done false
  9.  
  10. set USE_PRESERVE 0 ;# MUST MATCH
  11.  
  12. set worker_script {
  13.  
  14. set USE_PRESERVE 0 ;# MUST MATCH
  15.  
  16. proc work {main} {
  17. set result 0
  18. while 1 {
  19. puts "[thread::id] asking for work"
  20.  
  21. set work [thread::send $main get_work]
  22. if {$work eq ""} break
  23.  
  24. puts "[thread::id] doing $work"
  25. after 1
  26. thread::send -async $main [list give_result [thread::id] $work]
  27. }
  28. puts "[thread::id] done!"
  29. thread::send -async $main [list remove_worker [thread::id]]
  30. if {$::USE_PRESERVE} {
  31. thread::release
  32. } else {
  33. thread::exit
  34. }
  35. }
  36.  
  37. thread::wait
  38. }
  39.  
  40. proc get_work {} {
  41. puts "Main distributing work from {$::unfinished_work}"
  42. set ::unfinished_work [lassign $::unfinished_work work]
  43. return $work
  44. }
  45.  
  46. proc give_result {wid result} {
  47. puts "Main receiving finished work: $result"
  48. lappend ::finished_work $result
  49. }
  50.  
  51. proc remove_worker {wid} {
  52. puts "Main removing $wid"
  53. set status [thread::join $wid]
  54. puts "Main removed $wid: $status"
  55. if {[dict unset ::workers $wid] eq ""} {
  56. puts "Main done!"
  57. set ::is_done true
  58. }
  59. }
  60.  
  61. proc start_worker {} {
  62. if {$::USE_PRESERVE} {
  63. set id [thread::create -preserved -joinable $::worker_script]
  64. } else {
  65. set id [thread::create -joinable $::worker_script]
  66. }
  67. dict set ::workers $id working
  68. thread::send -async $id [list work [thread::id]]
  69. return $id
  70. }
  71.  
  72.  
  73. for {set i 0} {$i < $::n_workers} {incr i} {
  74. set wid [start_worker]
  75. puts "Started worker: $wid"
  76. }
  77. vwait is_done
  78.  
  79. puts "Results: $::finished_work"
  80. puts "Remaining threads: [thread::names]"
  81.