Posted to tcl by bairui at Thu Apr 27 10:09:11 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 n_workers 7
  6. set is_done false
  7.  
  8. proc get_work {} {
  9. puts "Main distributing work from {$::unfinished_work}"
  10. set ::unfinished_work [lassign $::unfinished_work work]
  11. return $work
  12. }
  13.  
  14. proc give_result {result} {
  15. puts "Main receiving finished work: $result"
  16. lappend ::finished_work $result
  17. }
  18.  
  19. proc remove_worker {tid wid} {
  20. set status [thread::join $tid]
  21. set workers [expr [llength [thread::names]] - 1]
  22. puts "Main removing worker $wid with status $status. Remaining number of workers: $workers"
  23. if {$workers == 0} {
  24. puts "Main retiring -- all workers done"
  25. set ::is_done true
  26. }
  27. }
  28.  
  29. proc start_worker {wid} {
  30. set id [thread::create -joinable {
  31. proc work {main wid} {
  32. set result 0 ;# simulate work-result with incrementing local integer
  33. while 1 {
  34. puts "Worker $wid asking for work"
  35. set work [thread::send $main get_work]
  36. if {$work eq ""} break
  37. puts "Worker $wid doing work $work"
  38. after 1 ;# simulate workload (using value of 1 to speed up multiple iteration tests)
  39. thread::send -async $main [list give_result [list $wid $work [incr result]]]
  40. }
  41. thread::send -async $main [list remove_worker [thread::id] $wid]
  42. thread::release
  43. }
  44. thread::wait
  45. }]
  46. thread::send -async $id [list work [thread::id] $wid]
  47. }
  48.  
  49. for {set wid 0} {$wid < $n_workers} {incr wid} {
  50. start_worker $wid
  51. }
  52. vwait is_done
  53.  
  54. puts "Main results: $finished_work"
  55. puts "Main remaining threads: [thread::names]"
  56.