Posted to tcl by mjanssen at Sat Apr 22 20:00:43 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"
  7. puts $::allwork
  8. set ::allwork [lassign $::allwork work]
  9. return $work
  10. }
  11.  
  12. proc start_worker {main} {
  13. set id [thread::create {
  14. proc start tid {
  15. while 1 {
  16. puts "[thread::id]: Asking for work"
  17. set work [thread::send $tid getwork]
  18. if {$work ne {}} {
  19. puts "[thread::id]: Doing work $work"
  20. after 1000
  21. } else {
  22. puts "[thread::id]: No more work"
  23. thread::exit
  24. }
  25. }
  26. }
  27. vwait forever
  28. }]
  29. thread::send -async $id [list start $main]
  30. }
  31. # start 2 workers
  32. time [list start_worker [thread::id]] 2
  33.  
  34. vwait forever
  35.  
  36.