console show
 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 {
        set s [string trim $s]
        #tk_messageBox -message $s
        if [regexp {^H'([0-9A-F]+)'$} $s -> s] {set s [expr 0x$s]}
        if [regexp {^D'([0-9A-F]+)'$} $s -> s] {set s $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
        variable ram
        upvar $_sym sym
        puts "\n dump...prog memory"
        foreach i [lsort -integer [array names mem]] {
            puts [format " %04d %s" $i $mem($i)]
        }
        puts "\n dump...sym names"
        foreach i [lsort [array names sym]] {
            puts [format " %-10s: %04x" $i $sym($i)]
        }
        
    }
    proc run {{pc 0}} {
        puts "\n running ASM program..."
        #incr pc -1
        variable mem
        foreach i {A B C D E Z W} {set ::$i 0}
        #tk_messageBox -message "pc: $pc: $mem($pc)"
        
        while {$pc>=0} {
            incr pc
            #tk_messageBox -message "pc: $pc: $mem($pc)"
            if {[info exists mem($pc)]} {
            #puts "$mem($pc)\tA:$::A B:$::B C:$::C D:$::D E:$::E Z:$::Z"
            #tk_messageBox -message "$mem($pc)\tA:$::A B:$::B C:$::C D:$::D E:$::E Z:$::Z"
            eval $mem($pc)
            } else {
              break
            }
        }
        puts " ASM program ended..."
    }
    #----------------- "machine opcodes" implemented as procs
    proc SHOWRAM dummyNr {
      variable ram
      puts "---RAM dump"
      foreach i [lsort [array names ram]] {
        puts "$i: $ram($i)"
      }
    }
    proc ADDWF {adr dest}  {
      variable ram
      if {$dest == "W"} {
        set ::W [expr $ram($adr) + $::W]
      } else {
        set ram($adr) [expr $ram($adr) + $::W]
      }
      }
    proc CALL {name}      {[string tolower $name] $::W}
    
    proc GOTO adr         {
      #tk_messageBox -message "GOTO $adr"
      uplevel 1 set pc [expr $adr - 1]
    }
    
    proc INCF  adr        {
      variable ram
      set ram($adr) [expr $ram($adr) + 1]      
      }
    proc DECFSZ adr {
      variable ram
      set ram($adr) [expr $ram($adr) - 1]
      if {$ram($adr) == 0} {uplevel 1 set pc [expr [uplevel 1 set pc] +1]}    
    }
    proc MOV  {reg adr}   {variable mem; set ::$reg $mem($adr)}
    
    proc MOVWF adr   {
      variable ram
      if {$adr == "INDF"} {
        set fsrC $ram(FSR)
        set ram($fsrC) $::W
      } else {
        set ram($adr) $::W
      }
    }
    proc MOVFW  adr   {
      variable ram
      set ::W $ram($adr)
    }
    proc MVI  {reg value} {set ::$reg $value}
    proc MOVLW  value {set ::W [convertHex $value]}
 }

#-- Now testing:
 asm::asm {
        org  0    ; the canonical start address in PICs
        movlw 0
        movwf offset
        movlw H'20'
        movwf chrix        
        movlw H'30'
        movwf FSR
        movlw D'16'
        movwf counter
 WEER:  movfw counter
        addwf chrix,w
        movwf INDF
        ;call puts
        incf FSR
        decfsz counter
        goto weer
        incf offset
        incf chrix
        end
 }

 asm::run
 
 puts "\n RAM after run:"
 puts " addr contents"
 puts " ----  --"  
 foreach i [lsort [array names asm::ram]] {
    #puts "$i [string is integer $i]"
    if [string is integer $i] {
      puts [format " %04x: %02x (%c)" $i $asm::ram($i) $asm::ram($i)]
    } else {
      puts [format " %-10s: %02x" $i $asm::ram($i)]    
    }
 }