Version 16 of Visual TAL
Updated 2013-12-02 14:18:24 by suchenwiRichard Suchenwirth 2013-12-01 - Last night on the Tclers' Chat, stu challenged me to write a visual emulator for TAL. Challenge accepted, after some 3 hours here is (another iteration of) the initial code that managed to step (with the <Down> key) through the TAL code emulating hypot.
On top you can enter a proc (with fixed name "f"), hit <Return> to get its body dis- and reassembled.
In the main window at left you see the TAL source code (ready to assemble, hopefully) in black, while the disassemble code is added as comments in red (just in case dis2asm did something wrong). The yellow highlighting marks the code that will be executed next.
On the right the local variables are displayed (you can edit their values), and below that the current stack.
Of the 130 TAL instructions, only a few have been implemented so far (see vtal.eval below), just the bare minimum to get the hypot example and others going... But more is to come. The underlying idea is that you will also be able to edit the displayed TAL source, and run it again... lots of bells and whistles in planning...
Following is the morning edition for 2013-12-02. New feature: set a breakpoint by right-clicking, shows this stop sign 
#!/usr/bin/env tclkit
# vtal.tcl -- Visual TAL
set thisdir [file dirname [info script]]
source $thisdir/tal.tcl
proc vtal {{w ""}} {
package require Tk
wm title . "Visual TAL"
global g
set g(stack) ---bottom---
if {$w ne ""} {pack [frame $w] -fill both -expand 1}
pack [frame $w.top] -side top
button $w.top.1 -text "Step" -command {vtal.step $g(txt)}
button $w.top.2 -text Run -command vtal.run
button $w.top.2a -text Reset -command vtal.reset
label $w.top.3 -text "proc f "
entry $w.top.4 -width 80 -textvar g(entry)
bind $w.top.4 <Return> vtal.refresh
eval pack [winfo children $w.top] -side left -fill y
pack [label $w.info -textvariable g(Info)] -side bottom
set g(Info) "Welcome to Visual TAL"
pack [frame $w.right] -side right -fill both -expand 1
pack [label $w.right.1 -text "Local variables" -relief raised] -fill x
set g(vars) $w.right.vars
pack [frame $g(vars)] -fill x
pack [label $w.right.2 -text Stack -relief raised] -fill x
pack [text $w.right.stack -width 32] -fill both -expand 1
set g(stk) $w.right.stack
pack [scrollbar $w.y -command "$w.t yscroll"] -side right -fill y
pack [text $w.t -wrap word \
-width 72 -yscrollcommand "$w.y set"] -fill both -expand 1
$w.t tag configure hilite -background yellow
set g(txt) $w.t
foreach i {red blue} {$w.t tag configure $i -foreground $i}
bind all <Down> {vtal.step $g(txt)}
vtal.showstack
}
proc vtal.reset {} {
global g
vtal.hilite $g(txt) 2
set g(stack) ---bottom---
vtal.showstack
set g(Info) Ready.
}
proc vtal.refresh {{function ""}} {
global g
if {$function ne ""} {set g(entry) $function}
vtal.reset
if [catch [list eval [linsert $g(entry) 0 proc f]] msg] {
set g(Info) $msg
return
}
foreach {argl} $g(entry) break
set asm [dis2asm [disasm proc f]]
set res [list proc f $argl [list asm $asm]]
if [catch $res msg] {
set g(Info) $msg
return
}
vtal.show $g(txt) $res
}
proc vtal.show {w str} {
$w delete 1.0 end
foreach line [split $str \n] {
if {[regexp {^(proc|\})} $line]} {
$w insert end $line\n blue
} else {
foreach {code cmt rest} [split $line #] break
set code [string trimright $code ";"]
if {$cmt ne ""} {set cmt ";#$cmt"}
if {$rest ne ""} {set rest #$rest}
$w insert end $code "" $cmt red $rest\n red
}
}
$w tag add hilite 2.0 2.end
vtal.vars
}
proc vtal.vars {} {
global g slot
set w $g(vars)
eval destroy [winfo children $w]
set i 0
foreach {num lvar} [array get slot] {
set varname [lindex $lvar end]
if {$varname eq "temp"} {set varname $num}
grid [label $w.[incr i] -text "%v$num: $lvar"] \
[entry $w.[incr i] -textvariable g(var,$varname)] -sticky w
}
}
proc vtal.step w {
foreach {from to} [$w tag ranges hilite] break
if ![info exists from] return
set lineno [lindex [split $from .] 0]
set cmd [$w get $from $to]
incr lineno
if {[string match \}* $cmd]} return
set ::g(Info) $cmd
set lineno [vtal.eval $cmd $lineno]
vtal.hilite $w $lineno
}
proc vtal.eval {cmd line} {
global g
foreach part [split $cmd ";"] {
if [string match #* [string trim $part]] {return $line}
foreach {instr arg1 arg2} $part break
if ![info exists instr] {return $line}
switch $instr {
add {push [expr {[pop]+[pop]}]}
concat {push [vtal.concat $arg1]}
div {set x [pop]; push [expr {[pop] / $x}]}
expon {set x [pop]; push [expr {[pop]**$x}]}
ge {set x [pop]; push [expr {[pop] >= $x}]}
gt {set x [pop]; push [expr {[pop] > $x}]}
incr {push [expr {[pop]+$arg1}]}
incrImm {push [vtal.store $arg1 [expr {[vtal.load $arg1] + $arg2}]]}
invokeStk {push [vtal.invoke $arg1]}
jump {set line [vtal.jump $arg1]}
jumpTrue {if {[pop] != 0} {set line [vtal.jump $arg1]}}
jumpFalse {if {[pop] == 0} {set line [vtal.jump $arg1]}}
label {}
listIndex {set x [pop]; push [lindex [pop] $x]}
listLength {push [llength [pop]]}
load {push [vtal.load $arg1]}
le {set x [pop]; push [expr {[pop] <= $x}]}
lt {set x [pop]; push [expr {[pop] < $x}]}
mod {set x [pop]; push [expr {[pop] % $x}]}
mult {push [expr {[pop]*[pop]}]}
pop pop
push {push $arg1}
store {vtal.store $arg1 [lindex $g(stack) 0]}
sub {set x [pop]; push [expr {[pop] - $x}]}
uminus {push [expr {-[pop]}]}
"" {}
default {set g(Info) "$part not yet implemented"}
}
}
return $line
}
proc vtal.concat num {
set res {}
while {$num > 0} {
set res [pop]$res
incr num -1
}
return $res
}
proc vtal.invoke num {
set cmd {}
while {$num > 0} {
set cmd [linsert $cmd 0 [pop]]
incr num -1
}
catch $cmd res
return $res
}
proc vtal.jump label {
global g
set pos [$g(txt) search "label $label" 1.0]
if {$pos eq ""} {error "label $label not found"}
set line [lindex [split $pos .] 0]
}
proc vtal.load name {return $::g(var,$name)}
proc vtal.store {name value} {set ::g(var,$name) $value}
proc pop {} {
global g
set res [lindex $g(stack) 0]
set g(stack) [lrange $g(stack) 1 end]
vtal.showstack
return $res
}
proc push what {
global g
set g(stack) [linsert $g(stack) 0 $what]
vtal.showstack
}
proc vtal.showstack {} {
global g
$g(stk) delete 1.0 end
$g(stk) insert 1.0 [join $g(stack) \n]
}
proc vtal.hilite {w line} {
$w tag remove hilite 1.0 end
$w tag add hilite $line.0 $line.end+1c
}
vtal
#-- demo function for starters
#vtal.refresh {{x y} {expr {$x%2? acos(-1) : sqrt(2)}}}
vtal.refresh {x {foreach i $x {puts ($i)}}}