namespace eval asm {
proc asm body {
variable mem
catch {unset mem} ;# good for repeated sourcing
foreach line [split $body \n] {
foreach i {label op args} {set $i ""}
regexp {([^;]*);} $line -> line ;# strip off comments
regexp {^ *(([A-Z0-9]+):)? *([A-Z]*) +(.*)} [string toupper $line]\
-> - label op args
puts label=$label,op=$op,args=$args
if {$label!=""} {set sym($label) $PC}
if {$op==""} continue
if {$op=="DB"} {set mem($PC) [convertHex $args]; incr PC; continue}
if {$op=="EQU"} {set sym($label) [convertHex $args]; continue}
if {$op=="ORG"} {set PC [convertHex $args]; continue}
regsub -all ", *" $args " " args ;# normalize commas
set mem($PC) "$op $args"
incr PC
}
substituteSymbols sym
dump sym
}
proc convertHex s {
if [regexp {^([0-9A-F]+)H$} [string trim $s] -> s] {set s [expr 0x$s]}
set s
}
proc substituteSymbols {_sym} {
variable mem
upvar $_sym sym
foreach i [array names mem] {
set tmp [lindex $mem($i) 0]
foreach j [lrange $mem($i) 1 end] {
if {[array names sym $j]==$j} {set j $sym($j)}
lappend tmp $j
}
set mem($i) $tmp
}
}
proc dump {_sym} {
variable mem
upvar $_sym sym
foreach i [lsort -integer [array names mem]] {
puts [format "%04d %s" $i $mem($i)]
}
foreach i [lsort [array names sym]] {
puts [format "%-10s: %04x" $i $sym($i)]
}
}
proc run {{pc 255}} {
variable mem
foreach i {A B C D E Z} {set ::$i 0}
while {$pc>=0} {
incr pc
#puts "$mem($pc)\tA:$::A B:$::B C:$::C D:$::D E:$::E Z:$::Z"
eval $mem($pc)
}
}#----------------- "machine opcodes" implemented as procs proc ADD {reg reg2} {set ::Z [incr ::$reg [set ::$reg2]]}
proc ADI {reg value} {set ::Z [incr ::$reg $value]}
proc CALL {name} {[string tolower $name] $::A}
proc DCR {reg} {set ::Z [incr ::$reg -1]}
proc INR {reg} {set ::Z [incr ::$reg]}
proc JMP where {uplevel 1 set pc [expr $where-1]}
proc JNZ where {if $::Z {uplevel 1 JMP $where}}
proc JZ where {if !$::Z {uplevel 1 JMP $where}}
proc MOV {reg adr} {variable mem; set ::$reg $mem($adr)}
proc MVI {reg value} {set ::$reg $value}
}#-- Now testing: asm::asm {
org 100 ; the canonical start address in CP/M
jmp START ; idiomatic: get over the initial variable(s)
DONE: equ 0 ; warm start in CP/M ;-)
MAX: equ 5
INCR: db 2 ; a variable (though we won't vary it)
;; here we go...
START: mvi c,MAX ; set count limit
mvi a,0 ; initial value
mov b,INCR
LOOP: call puts ; for now, fall back to Tcl for I/O
inr a
add a,b ; just to make adding 1 more complicated
dcr c ; counting down..
jnz LOOP ; jump on non-zero to LOOP
jmp DONE ; end of program
end
}The mov b,INCR part is an oversimplification. For a real 8080, one would have to sayLXI H,INCR ; load double registers H+L with the address INCR MOV B,M ; load byte to register B from the address pointed to in HLSince the pseudo-register M can also be used for writing back, it cannot be implemented by simply copying the value. Rather, one could use read and write traces on variable M, causing it to load from, or store to, mem($HL). Maybe another weekend...
Keith Vetter - How about a MIX simulator so I can get all of Knuth's algorithms working?
escargo 26 Mar 2004 - I have sometimes wondered if there should be an assembly language level interface to the Tcl byte code.
Category Language - Tcl and other languages - Arts and crafts of Tcl-Tk programming