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

#
# tcl thread eventmark bug demo
#
# creates a producer thread and uses the main thread as a consumer thread
#
# the consumer thread sends to the producer thread to invoke blast,
# a proc that continuously generates async events to the consumer thread
#
# the consumer thread is configured using thread::configure -eventmark
# to limit the number of asynchronously posted scripts to the consumer's
# thread event loop
#
# the bug is that once the eventmark limit is reached, no further events
# are sent
#
# apparently the consumer consuming events does not decrease the number
# of pending events that the eventmark is looking at, or the act of
# performing pending events does not wake up the producer
#
# if you comment out the eventmark config, it works as expected
#
# also if you use thread::wait on the consumer thread instead of vwait
# it works
#

package require Thread

set consumerThread [thread::id]

thread::configure $consumerThread

set workers {}

for {set i 0} {$i < 8} {incr i} {
	lappend workers [thread::create {

	proc ack args {
		variable limit
		variable posts
		if {[incr posts -1] <= $limit} {
			after 0 [list after idle blast]
		}
	}

	proc main {thread newlimit} {
		variable consumer $thread
		variable posts 0
		variable result 0

		variable limit
		set limit $newlimit
		trace add variable ::result write ack
		after 0 [list after idle blast]
	}

	proc blast {} {
		variable consumer
		variable limit
		variable posts
		variable timer
		if {$posts <= $limit} {
			puts "posting some more after $timer"
			thread::send -async $consumer [list hiya [thread::id]] result
			incr posts
			after $timer [list after idle blast]
		} else {
			puts "sleeping ..."
		}

	}

	thread::wait
	}]
}

foreach worker $workers {
	thread::configure $worker -eventmark [incr eventmark 3] 
	thread::send $worker [list incr timer [incr timer 100]]
}

proc hiya from {
	puts "hiya from $from"
	after 50 
}

foreach worker $workers {
	thread::send -async $worker [list main $consumerThread [incr limit 3]]
}

thread::wait

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.