[Richard 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.

[tal.tcl_002.png]

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 end-of-day edition for 2013-12-01.
======
#!/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}
    #. configure -menu [menu .m]
    #m+ File Exit exit
    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 Info] -side bottom
    set ::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 $w.t <1> {vtal.hilite %W .}
    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 ::Info Ready.
}
proc vtal.refresh {} {
    global g
    vtal.reset
    if [catch [list eval [linsert $g(entry) 0 proc f]] msg] {
        set ::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 ::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
            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]
        grid [label $w.[incr i] -text "%v$num: $lvar"] \
            [entry $w.[incr i] -textvariable g(var,$varname)] -sticky ew
    }
}
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 ::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]}]}
            div       {set x [pop]; push [expr {[pop] / $x}]}
            expon     {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]}
            load      {push [vtal.load $arg1]}
            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 ::Info "$part not yet implemented"}
        }
    }
    return $line
}
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.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 .}} {
    if {$line eq "."} {set line [lindex [split [$w index insert] .] 0]}
    $w tag remove hilite 1.0 end
    $w tag add hilite $line.0 $line.end
}
#------------------- utilities
 proc m+ {head name {cmd ""}} { 
    if {![winfo exists .m.m$head]} { 
         .m add cascade -label $head -menu [menu .m.m$head -tearoff 0] 
    } 
    if [regexp ^-+$ $name] { 
            .m.m$head add separator 
    } elseif {[regexp {^\?(.+)} $name -> name]} {
        .m.m$head add checkbutton -label $name -variable $cmd
    } else {.m.m$head add command -label $name -comm $cmd} 
 }

vtal


if [catch {set asm [aproc f {x y} {expr {sqrt($x**2 + $y**2)}} -x]}] {
    set asm {proc f {x y} {asm {
        push tcl::mathfunc::sqrt ;# (0) push1 0         # "tcl::mathfunc::sqrt"
        load x                   ;# (2) loadScalar1 %v0         # var "x"
        push 2                   ;# (4) push1 1         # "2"
        expon                    ;# (6) expon
        load y                   ;# (7) loadScalar1 %v1         # var "y"
        push 2                   ;# (9) push1 1         # "2"
        expon                    ;# (11) expon
        add                      ;# (12) add
        invokeStk 2              ;# (13) invokeStk1 2
        tryCvtToNumeric          ;# (15) tryCvtToNumeric
        ;# (16) done
    }}
    }
} 
set asm [aproc f {x y} {expr {sqrt($x**2 + $y**2)}} -x]
vtal.show .t $asm

======
<<categories>>Enter Category Here