Updated 2011-07-03 09:44:37 by dkf

Richard Suchenwirth 2005-04-30 - The M.U. & Tex. Railroad is a simple visualisation of mutex, or mutually exclusive semaphores (nl: seinpalen [1]) that control the works of concurrent processes, which are here displayed as "trains" (longish rectangles, rather).

The railway has two semaphores, A and B. A train may only pass a semaphore if given the green light. To make sure there's always at most one train on the line between A and B, a semaphore is turned to red when a train passes it - it "obtains a mutex lock" on the semaphore. This operation is called P (nl: passeren, "pass"; or "prolaag" which I can't explain) in mutex theory.

When the train leaves the protected block, at semaphore B, it "releases the lock" on A, so that is turned green again - the V operation (nl: vrijgeven, "release"; or "verhoog"). And of course it obtains a lock on B to prevent collisions :)
```proc main {} {
set w [canvas .c -width 700 -height 100]
pack \$w -fill both -expand 1
\$w create line 0 80 700 80
semaphore A \$w 100 80
turn A red
\$w create text 120 90 -text "P(A)"
semaphore B \$w 600 80
turn B green
\$w create text 630 90 -text "P(B); V(A)"
train \$w 200 80
train \$w -500 80
every 100 [list animate \$w]
}
proc semaphore {name w x y} {
global g
\$w create line \$x \$y \$x [- \$y 30] -width 2
\$w create rect [- \$x 5] [- \$y 30] [+ \$x 5] [- \$y 50] -fill black
set g(\$name,top) [lamp \$w \$x [- \$y 45]]
set g(\$name,bot) [lamp \$w \$x [- \$y 35]]
set g(\$name,x) \$x
lappend g(semaphores) \$name
\$w create rect [- \$x 5] [- \$y 10] [+ \$x 5] [- \$y 25] -fill white
\$w create text \$x [- \$y 18] -text \$name
set g(w) \$w
}
proc lamp {w x y} {
\$w create oval [- \$x 4] [- \$y 4] [+ \$x 4] [+ \$y 4]
}
proc train {w x y} {
set color [lpick {brown gray50 orange bisque}]
\$w create rect \$x \$y [+ \$x 250] [- \$y 30] -fill \$color -tag train
\$w lower train
}
#-- This routine is called in fixed time intervals
proc animate w {
foreach train [\$w find withtag train] {
set xmax [lindex [\$w bbox \$train] 2]
if {\$xmax > 1200} {
\$w delete \$train
train \$w -200 80
V B
}
if [semaphoreAhead \$xmax name] {
if {\$::g(\$name,state) eq "red"} continue
after 500 [list P \$name]
if {\$name eq "B"} {after 2500 {V A}}
}
\$w move \$train [expr {rand()*5+10}] 0
}
}
#-- Returns 1 if a semaphore is ahead, and gives its name in a variable
proc semaphoreAhead {xmax _var} {
upvar 1 \$_var var
foreach sema \$::g(semaphores) {
set dx [- \$::g(\$sema,x) \$xmax]
if {\$dx > 0 && \$dx < 30} {set var \$sema; return 1}
}
return 0
}
#-- Dijkstra's classic mutex operations are very simple here:
proc P name {turn \$name red}

proc V name {turn \$name green}

proc turn {name color} {
if {\$color eq "red"} {
set c1 red; set c2 black
} else {
set c1 black; set c2 green
}
\$::g(w) itemconfig \$::g(\$name,top) -fill \$c1
\$::g(w) itemconfig \$::g(\$name,bot) -fill \$c2
set ::g(\$name,state) \$color
}
#-- Generally useful routines: prefix math, etc.
foreach op {+ - * /} {proc \$op {a b} "expr {\\$a \$op \\$b}"}
proc every {ms body} {eval \$body; after \$ms [info level 0]}
proc lpick list {lindex \$list [expr {int(rand()*[llength \$list])}]}
#-- Let's go!
main
#-- Very useful development helper:
bind . <Escape> {exec wish \$argv0 &; exit}```