Tcl Thread using vwait produces random result - multithreading

Question

I've been trying to implement some multithreaded problems in Tcl. At some point I wanted to simulate the Fork/Join framework in Java where a thread spawns two "child" threads that each do half of the work. In order to do this in Tcl, you would create some threads with a startup script, put them to work to then wait for their result. My implementation uses joinable threads, asynchronous message sends with optional result variable and vwait on that variable, but produces irregular results. Sometimes the script finishes as expected, sometimes it keeps blocking on the vwait. Why can it sometimes block on the vwait, and otherwise run just fine? I have no idea why that would be; I followed the manual pages to the best of my knowledge.
Some sample code to demonstrate the behaviour:
package require Thread
set code {
proc run {} {
puts "I am running"
return 4
}
thread::wait
}
set t1 [ thread::create -joinable $code ]
set t2 [ thread::create -joinable $code ]
thread::send -async $t1 "run" res1
thread::send -async $t2 "run" res2
puts "Waiting"
vwait res1
vwait res2
puts "Releasing"
thread::release $t1
thread::release $t2
puts "Joining"
thread::join $t1
thread::join $t2
puts [ expr { $res1 + $res2 } ]
This sometimes produces (as expected):
Waiting
I am running
I am running
Releasing
Joining
8
... and sometimes:
Waiting
I am running
I am running
<keeps hanging here>
Spawning only 1 thread never seems to recreate the issue, or it might be that the underlying problem still remains but never manifests itself. Someone can hopefully shed some light on why this happens. Thanks in advance!

Answer 1

The threads can run in either order, yet vwait only waits on a single variable; it's possible for $t2 to finish its work (and set res2) before $t1 finishes (and sets res1). A simple way around this is to put the variables to wait on in an array and then vwait on the whole array:
thread::send -async $t1 "run" waiting(res1)
thread::send -async $t2 "run" waiting(res2)
puts "Waiting"
# Wait for the two sets to happen, in either order
vwait waiting
vwait waiting
puts "Releasing"
More generally, consider using a thread pool instead.
package require Thread
set code {
proc run {} {
puts "I am running"
return 4
}
# No thread::wait here!
}
set pool [tpool::create -maxworkers 2 -initcmd $code]
set task1 [tpool::post $pool run]
set task2 [tpool::post $pool run]
tpool::wait $pool $task1
tpool::wait $pool $task2

Answer 2

Your idea about a race condition (That the threads run in an order where the second one executes first) is correct, yes.
One alternative uses shared variables instead of having the run proc return a value, and condition variables to notify the parent thread that the run procedures are complete before killing the thread:
#!/usr/bin/env tclsh
package require Thread
set code {
proc run {m cond res} {
puts "$res is running"
tsv::incr results $res 4
thread::mutex lock $m
thread::cond notify $cond
thread::mutex unlock $m
}
thread::wait
}
set t1 [thread::create -joinable $code]
set t2 [thread::create -joinable $code]
set c1 [thread::cond create]
set c2 [thread::cond create]
set m1 [thread::mutex create]
set m2 [thread::mutex create]
thread::send -async $t1 [list run $m1 $c1 res1]
thread::send -async $t2 [list run $m2 $c2 res2]
puts "Running threads"
thread::mutex lock $m1
while {![tsv::exists results res1]} {
thread::cond wait $c1 $m1
}
thread::mutex unlock $m1
thread::mutex lock $m2
while {![tsv::exists results res2]} {
thread::cond wait $c2 $m2
}
thread::mutex unlock $m2
puts "Releasing"
thread::release $t1
thread::release $t2
puts "Joining" ;# Not sure if this is needed after the release or even valid
thread::join $t1
thread::join $t2
puts [expr {[tsv::get results res1] + [tsv::get results res2]}]

Answer 3

Thanks so much for the great ideas so far! I was able to solve my own problem, because when you explain the problem in just a few lines of code, it is easier to oversee what is going on. I would like to share my idea too. Look at the accepted answer for a better understanding of the problem.
I came up with an alternative solution that uses synchronous message sending after putting the threads to work with an asynchronous message. The Tcl manual specifies:
Many threads can simultaneously send scripts to the target thread for execution. All of them are entered into the event queue of the target thread and executed on the FIFO basis [...].
... which means that scripts sent to threads are processed in the order they arrive. You can make the thread accept a new script that just returns the resulting value and send that script synchronously to block until you get the result. This way, you don't have to use vwait at all because you rely on the FIFO script sending system.
The solution code looks like this:
package require Thread
set code {
set result 0
proc run {} {
upvar result result
puts "I am running"
set result 4
}
proc getResult {} {
upvar result result
return $result
}
thread::wait
}
set t1 [ thread::create -joinable $code ]
set t2 [ thread::create -joinable $code ]
thread::send -async $t1 "run" res1
thread::send -async $t2 "run" res2
puts "Waiting"
set res1 [ thread::send $t1 "getResult" ]
set res2 [ thread::send $t2 "getResult" ]
puts "Releasing"
thread::release $t1
thread::release $t2
puts "Joining"
thread::join $t1
thread::join $t2
puts [ expr { $res1 + $res2 } ]

Answer 4

This is to add an example of a third option for inter-thread comm using channel pipes (chan pipe) as a communication vehicle (rather than mutexes/ conditions, which are also used internally by tpool, if I am not utterly mistaken):
package require Thread
set code {
proc run {ch} {
puts "[thread::id] is running"
puts $ch 4
close $ch
}
thread::wait
}
set handler [list {pr tid} {
variable busy
variable data
set r [read $pr]
if {[eof $pr]} {
close $pr
unset busy($tid)
thread::release $tid
} else {
lappend data $r
}
} [namespace current]]
set t1 [thread::create $code]
lassign [chan pipe] pr1 pw1
chan configure $pw1 -blocking 0
chan configure $pr1 -blocking 0
thread::transfer $t1 $pw1
chan event $pr1 readable [list apply $handler $pr1 $t1]
thread::send -async $t1 [list run $pw1]
set busy($t1) $pr1
set t2 [thread::create $code]
lassign [chan pipe] pr2 pw2
chan configure $pw2 -blocking 0
chan configure $pr2 -blocking 0
thread::transfer $t2 $pw2
chan event $pr2 readable [list apply $handler $pr2 $t2]
thread::send -async $t2 [list run $pw2]
set busy($t2) $pr2
while {[array size busy]} {
vwait ::busy
}
puts [tcl::mathop::+ {*}$data]
Some remarks:
Pipes are elegant because inter-thread communication follows the model of channel communication (chan event, puts/ read);
They can be used to communicate between worker threads (not just the main one and the workers);
The above implementation is not ideal, as threads should not be created and destroyed on a per-job basis. Hence, tpool is more convenient to use and a better fit in the given situation, clearly;
Pipes can be used as a secondary communication line between threads (in a tpool), also;
You would have to introduce some procedure abstraction to hide the verbosity of the pipe-based solution;