Arjen Markus (26 august 2008) Multithreading may be a popular programming model, at least for some types of applications, it has a few properties which make it very difficult to use properly. First and foremost the possibility to get into shared data - not creating the right locks and releasing them in the right order. A second problem is that program execution is subject to truly random influences: if you run into a particular race condition, it may be very difficult if not impossible to reproduce it in a debugger.
The code below is a very modest attempt to model the running of a multithreaded program. It does not do classical synchronisation constructs (yet), such as mutexes and barriers, but it does detect the incorrect use of shared variables (if you indicate their use properly with "begin/end" statement).
It also does not transform the program code in a way that is necessary to make it model the behaviour of true multithreaded programs better: it should transform if {}, for {} etc. along these lines:
if { $cond } {
set var "new value""
set var2 "another value"
}into:
set _private_if_line_10 [expr {$cond}]
if { $_private_if_line_10 } { set var "new value" }
if { $_private_if_line_10 } { set var2 "another value" } That way commands in another thread can be run, possibly causing confusion - the sort of thing one wants to detect.
Anyway here is what it does do:
For all intents and purposes, it is primarily a proof of concept.
A simple example:
# sample_read_write.tcl
# Example of the use of "simulate_threads":
# We have two threads, one writing the numbers 1 to 10
# to shared memory, the other picking it up again.
# The correctness of the program is determined by:
# - Each thread can do its job (write ten numbers or
# read ten numbers).
# - The numbers that are read are the numbers 1 to 10.
# - No reading takes place while there is a write
# action
# The last condition is checked automatically, the
# first two are program-specific, so we check these
# manually.
#
# Note:
# We use simplified code and the critical sections
# are started and ended with the begin and end commands.
#
#
# Global parameters
#
set max_steps_per_run 1000
set number_runs 10
set random_seed [clock clicks] ;# Can be used to restart a particular run
set verbose 0 ;# If true, print the sequence of commands
initial {
set reader 0 ;# Nothing has been written so far, so the writer must go ahead
set value_expected 1
set value_to_store 1
}
thread Reader {
#
# Wait until the writer has finished
#
sleep {$reader == 0}
#
# We can go ahead
#
begin read
set value_read $value_stored
end read
set reader 0
puts "Read: $value_read"
assert {$value_read == $value_expected}
incr value_expected
}
thread Writer {
#
# Wait until the reader has finished
#
sleep {$reader == 1}
#
# We can go ahead
#
begin write
set value_stored $value_to_store
puts "Written: $value_stored"
end write
set reader 1
stop {$value_to_store == 10}
incr value_to_store
} And the simulation program itself:
# simulate_threads.tcl
# Program to simulate synchronisation mechanisms in threads:
# Do we use correct locks? Is starvation possible?
# By using a controlled environment it is much easier to
# examine the consequences of the choices we make.
#
# For an explanation of the program: see the example
#
# global variables --
#
set _simulation_(initial) {}
set max_steps_per_run 100
set number_runs 10
set random_seed [clock clicks] ;# Can be used to restart a particular run
set verbose 0 ;# If true, print the sequence of commands
set _number_threads_ 0
set _error_ 0
set _error_count_ 0
# initial --
# Define the initial condition - fragment executed before each run
#
# Arguments:
# script Script defining the initial conditions
#
# Result:
# None
#
# Side effects:
# Script stored for later use
#
proc initial {script} {
global _simulation_
set _simulation_(initial) $script
}
# thread --
# Define the thread and the code run by the thread
#
# Arguments:
# name Name of the thread
# script Code that should be run
#
# Result:
# None
#
# Side effects:
# Script and name stored for later use
#
proc thread {name script} {
global _simulation_
lappend _simulation_(threads) $name
set _simulation_($::_number_threads_) [Stripped $script]
incr ::_number_threads_
}
# Stripped --
# Strip empty lines and comments from the code
#
# Arguments:
# script Code to be stripped
#
# Result:
# Stripped code
#
proc Stripped {script} {
set stripped {}
foreach line [split $script \n] {
if { [string trim $line] != "" &&
![regexp {^ *#} $line] } {
lappend stripped $line
}
}
return $stripped
}
# begin, end --
# Commands to start and stop a critical section
#
# Arguments:
# type Type of action within the section (read or write)
#
# Result:
# None
#
# Side effects:
# Checks to see if the thread can enter the critical section or not
#
proc begin {type} {
switch -- $type {
"read" {
if { $::_write_in_progress_ } {
puts " Error in thread $::_thread_: write in progress!"
set ::_error_ 1
} else {
incr ::read_in_progress_
}
}
"write" {
if { $::_read_in_progress_ } {
puts " Error in thread $::_thread_: read in progress!"
set ::_error_ 1
} else {
incr ::write_in_progress_
}
}
}
}
proc end {type} {
switch -- $type {
"read" {
if { $::_write_in_progress_ } {
puts " Error in thread $::_thread_: write in progress!"
set ::_error_ 1
} else {
incr ::read_in_progress_ -1
}
}
"write" {
if { $::_read_in_progress_ } {
puts " Error in thread $::_thread_: read in progress!"
set ::_error_ 1
} elseif { $::_write_in_progress_ } {
puts " Error in thread $::_thread_: already a write in progress!"
set ::_error_ 1
} else {
incr ::write_in_progress_ -1
}
}
}
}
# assert, stop --
# Check a condition or stop a thread
#
# Arguments:
# condition Condition to be checked
#
proc assert {condition} {
if { ![uplevel [list expr $condition]]} {
puts " Error: assertion failed in thread [lindex $::_simulation_(active_threads) $::_t_] - $condition"
set ::_error_ 1
}
}
proc stop {condition} {
if { [uplevel [list expr $condition]]} {
puts " Thread [lindex $::_simulation_(active_threads) $::_t_] stopped - $condition"
set ::_simulation_(active_threads) [lreplace $::_simulation_(active_threads) $::_t_ $::_t_]
}
}
# sleep --
# Sleep if a condition is true
#
# Arguments:
# condition Condition to be checked
#
proc sleep {condition} {
if { [uplevel [list expr $condition]]} {
set ::_simulation_($::_t_,delta) 0
} else {
set ::_simulation_($::_t_,delta) 1
}
}
# runall --
# Run all runs
#
# Arguments:
# None
#
proc runall {} {
for {set i 0} {$i < $::number_runs} {incr i} {
puts "Run $i - random seed: $::random_seed"
expr {srand($::random_seed)}
set ::_read_in_progress_ 0
set ::_write_in_progress_ 0
ClearThreadAdmin
run
set ::random_seed [clock clicks]
}
puts "Number of runs with errors: $::_error_count_"
}
# ClearThreadAdmin --
# Prepare the thread administration for a new run
#
# Arguments:
# None
#
# Result:
# None
#
proc ClearThreadAdmin {} {
global _simulation_
for { set i 0 } { $i < $::_number_threads_ } { incr i } {
set _simulation_($i,cmd) 0
set _simulation_($i,delta) 1
}
set _simulation_(active_threads) $_simulation_(threads)
}
# run --
# Run the commands in the threads and check for correctness
#
# Arguments:
# None
#
# Result:
# None
#
# Side effects:
# A lot
#
proc run {} {
global _simulation_
eval $_simulation_(initial)
for {set _i_ 0} {$_i_ < $::max_steps_per_run} {incr _i_} {
#
# Select which thread to run now
#
if { [llength $_simulation_(active_threads)] == 0 } {
break
}
set ::_t_ [expr {int(rand()*[llength $_simulation_(active_threads)])}]
set cmd [lindex $_simulation_($::_t_) $_simulation_($::_t_,cmd)]
if { $::verbose } {
# puts " [lindex $_simulation_(threads) $::_t_]: $cmd"
puts " [lindex $_simulation_(threads) $::_t_]: $cmd -- $_simulation_($::_t_,cmd)"
}
eval $cmd
if { $::_error_ } {
incr ::_error_count_
break
}
incr _simulation_($::_t_,cmd) $_simulation_($::_t_,delta)
if { $_simulation_($::_t_,cmd) >= [llength $_simulation_($::_t_)] } {
set _simulation_($::_t_,cmd) 0
}
}
puts " Threads alive: $_simulation_(active_threads)"
}
# main --
# Run the simulation
#
source [lindex $argv 0]
runall