Posted to tcl by pooryorick at Thu Mar 26 17:13:56 GMT 2015view raw

  1. #
  2. # tcl thread eventmark bug demo
  3. #
  4. # creates a producer thread and uses the main thread as a consumer thread
  5. #
  6. # the consumer thread sends to the producer thread to invoke blast,
  7. # a proc that continuously generates async events to the consumer thread
  8. #
  9. # the consumer thread is configured using thread::configure -eventmark
  10. # to limit the number of asynchronously posted scripts to the consumer's
  11. # thread event loop
  12. #
  13. # the bug is that once the eventmark limit is reached, no further events
  14. # are sent
  15. #
  16. # apparently the consumer consuming events does not decrease the number
  17. # of pending events that the eventmark is looking at, or the act of
  18. # performing pending events does not wake up the producer
  19. #
  20. # if you comment out the eventmark config, it works as expected
  21. #
  22. # also if you use thread::wait on the consumer thread instead of vwait
  23. # it works
  24. #
  25.  
  26. package require Thread
  27.  
  28. set consumerThread [thread::id]
  29.  
  30. thread::configure $consumerThread
  31.  
  32. set workers {}
  33.  
  34. for {set i 0} {$i < 8} {incr i} {
  35. lappend workers [thread::create {
  36.  
  37. proc ack args {
  38. variable limit
  39. variable posts
  40. if {[incr posts -1] <= $limit} {
  41. after 0 [list after idle blast]
  42. }
  43. }
  44.  
  45. proc main {thread newlimit} {
  46. variable consumer $thread
  47. variable posts 0
  48. variable result 0
  49.  
  50. variable limit
  51. set limit $newlimit
  52. trace add variable ::result write ack
  53. after 0 [list after idle blast]
  54. }
  55.  
  56. proc blast {} {
  57. variable consumer
  58. variable limit
  59. variable posts
  60. variable timer
  61. if {$posts <= $limit} {
  62. puts "posting some more after $timer"
  63. thread::send -async $consumer [list hiya [thread::id]] result
  64. incr posts
  65. after $timer [list after idle blast]
  66. } else {
  67. puts "sleeping ..."
  68. }
  69.  
  70. }
  71.  
  72. thread::wait
  73. }]
  74. }
  75.  
  76. foreach worker $workers {
  77. thread::configure $worker -eventmark [incr eventmark 3]
  78. thread::send $worker [list incr timer [incr timer 100]]
  79. }
  80.  
  81. proc hiya from {
  82. puts "hiya from $from"
  83. after 50
  84. }
  85.  
  86. foreach worker $workers {
  87. thread::send -async $worker [list main $consumerThread [incr limit 3]]
  88. }
  89.  
  90. thread::wait
  91.  

Comments

Posted by pooryorick at Thu Mar 26 17:17:33 GMT 2015 [text] [code]

Ignore the comment at the top of the script - I should have deleted it as it only applied to the script this was based on.