#!/usr/bin/tclsh8.4

if {[llength $argv] != 3} { error "need args: serial port, map file, picno" }
set port [lindex $argv 0]
set map [lindex $argv 1]
set slave [lindex $argv 2]

set m [open $map]
set block preable
set headings unknown
set inblk 3

proc manyset {list args} {
    foreach val $list var $args { upvar 1 $var my; set my $val }
}

proc inblk {bre hre} {
    global inblk block headings
    return [expr {
	$inblk==3 &&
	[regexp $bre $block] &&
	[regexp $hre $headings]
    }]
}

proc wantlockind {lockind thing l} {
    switch -exact $lockind  program { return -1 }  data { return 1 }  \
	default { error "unknown $thing lockind $lockind in $l" }
}

while {[gets $m l] >= 0} {
    if {![regexp {\S} $l]} {
	set inblk 0
	set section unknown
	set headings n/a
    } elseif {$inblk==0 && [regexp {^\s+(\S.*\S)\s*$} $l dummy block]} {
	incr inblk
    } elseif {$inblk==1} {
	set headings [string trim $l]
	incr inblk
    } elseif {$inblk==2 && [regexp {^[- \t]+$} $l]} {
	incr inblk
    } elseif {[inblk {^Section Info$} \
	    {^Section\s+Type\s+Address\s+Location\s+Size\(Bytes\)$}]} {
	manyset $l sec type addr lockind size
	switch -exact $type  code { continue }  udata { } \
		default { error "unknown section type $type in $l" }
	if {[wantlockind $lockind section $l]<=0} continue
	set addr [format 0x%08x $addr]
	lappend sections [list $addr $sec [format 0x%08x $size]]
    } elseif {[inblk {^Symbols$} \
	    {^Name\s+Address\s+Location\s+Storage\s+File$}]} {
	manyset $l sym addr lockind storage file
	if {![wantlockind $lockind symbol $l]} continue
	switch -exact $storage {
	    extern { set sym [list {} $sym] }
	    static {
		regexp {^(.*)\.asm$} $file dummy file
		set sym [list $file: $sym]
	    }
	    default { error "unknown storage $storage in $l" }
	}
	set addr [format 0x%08x $addr]
	if {[string compare $lockind data]} {
	    set sv symbolsbylockind($lockind)
	} else {
	    set sv symbols
	}
	lappend $sv [list $addr $sym]
    } elseif {$inblk==3} {
    } else {
	error "unknown $inblk <$block> <$headings> $l"
    }
}

set ok {
    INTCON* FSR2*
    OSCCON LVDCON WDTCON RCON
    T1CON T2CON
    SSPADD SSPSTAT SSPCON1 SSPCON2
    ADRESH ADRESL ADCON*
    CCPR1* CCP1CON
    ECCPR1* ECCP1DEL ECCPAS
    CMCON CVRCON T3CON
    SPBRG TXSTA RXSTA
    EEADR EEDATA
    IPR* PIR* PIE*
    TRIS* LAT*
}

set h [open /usr/share/gputils/header/p18f458.inc]
set section unknown
set lastaddr -1
while {[gets $h l]>=0} {
    if {[regexp {^\;\-\-+\s+(\S.*\S)\s+\-\-+$} $l dummy section]} {
	continue
    } elseif {![regexp {^Register Files$} $section]} {
	continue
    } elseif {[regexp -nocase \
	    {^([a-z][a-z0-9]*)\s+equ\s+h\'0(f[0-9a-f]{2})\'\s*$} \
	    $l dummy sym loc]} {
	set addr [format 0x%08x 0x$loc]
	foreach pat $ok {
	    if {[string match $pat $sym]} {
		if {$addr != $lastaddr} {
		    lappend sections [list $addr =SFRs= 0x1]
		    set lastaddr $addr
		}
		lappend symbols [list $addr [list SFR $sym]]
	    }
	}
    } elseif {[regexp -nocase {^\;\s*reserved} $l]} {
    } elseif {![regexp {\S} $l]} {
    } else {
	error "unknown <$section> $l"
    }
}

lappend sections [list 0x1000 =END= 0]
set sections [lsort $sections]
set symbols [lsort $symbols]

set p [open $port {RDWR NONBLOCK} 0]
exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
	-ctlecho -echo -echoe -echok -echonl -iexten -isig \
	-icanon -icrnl \
	9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
	-ixoff bs0 cr0 ff0 nl0 -ofill -olcuc

fconfigure $p -blocking yes -buffering none \
	-translation binary -encoding binary

fconfigure stdout -buffering none

set ms [expr {
    $slave < 0 ? "t" :
    $slave ? "s" :
    "m"
}]

proc xmit {b} {
    global p
#puts stderr >xmit|$b<
    set b [expr $b]
    set c [binary format c* $b]
    puts -nonewline $p [format %c $b]
}
proc recv {n} {
    global p
    set l {}
    while {$n > 0} {
	set c [read $p 1]
	binary scan $c c* d
	if {![llength $d]} { error "comms eof" }
	lappend l $d
	incr n -1
    }
    return $l
}

proc selectslave_s {} {
    global slave
    xmit "$slave ^ 0x30"
}

proc xmit_s {b} {
    xmit "$b | 0x80"
    selectslave_s
    recv 1
}

proc setup_m {} { xmit 0 }
proc setup_s {} { xmit 0; xmit_s 0 }
proc setup_t {} { }

proc selectaddr_ms {xmit a} {
    $xmit "($a >> 6) | 0x40"
    $xmit "($a & 0x3f) | 0x40"
}
proc selectaddr_m {a} { selectaddr_ms xmit $a }
proc selectaddr_s {a} { selectaddr_ms xmit_s $a }
proc selectaddr_t {a} { global tsa; set tsa $a }
    
proc readbytes_m {n} {
    xmit "$n | 0x10"
    return [recv $n]
}
proc readbytes_s {n} {
    xmit $n
    selectslave_s
    return [recv $n]
}
    
proc readbytes_t {n} {
    global tsa
    set l {}
    while {$n > 0} {
	lappend l [expr {$tsa - ($tsa >> 8)}]
	incr tsa
	incr n -1
    }
    return $l
}

set readcursor -1

proc readbytes {addr n} {
    global readcursor ms
    if {$readcursor != $addr} {
	if {$addr & ~0x0fff} { error "bad addr $addr" }
	if {$n > (0x1000 - $addr)} { error "bad len $addr+$n" }
	selectaddr_$ms $addr
    }
    set r [readbytes_$ms $n]
    set readcursor [expr {$addr + $n}]
    return $r
}

proc thingbynum {thing nnum} {
    upvar #0 ${thing}num num
    upvar #0 ${thing}s things
    upvar #0 ${thing}info info
    upvar #0 ${thing}addr addr
    upvar #0 ${thing} name
    set num $nnum
    if {$num < [llength $things]} {
	set info [lindex $things $num]
    } else {
	set info {0x7fffffff =DUMMY-END= 1}
    }
    manyset $info addr name
    if {![string compare $thing section]} {
	global sectionsize sectionend
	set sectionsize [lindex $info 2]
	set sectionend [expr {$addr + $sectionsize}]
    }
}

proc thingnext {thing} {
    upvar #0 ${thing}num num
    incr num
    thingbynum $thing $num
}

thingbynum section 0
thingbynum symbol 0
set shownsection {}
set sectionchange 0
set insection 0
set addr 0
set now_max 4
set inline -1
set displine 0

proc p {s} { puts -nonewline $s }

setup_$ms

proc endline {} {
    global inline displine
    if {$inline} { p "\n"; incr displine }
    set inline 0
}

proc show {sym} {
    global insection section displine addr shownsection inline shownss
    set showsectionend 0
    if {$insection && [string compare $section $shownsection]} {
	endline
	p "---------- $section ----------\n"
	set shownsection $section
	set displine 0
    } elseif {!$insection && [string length $shownsection]} {
	endline
	p "------------------------------\n"
	set shownsection {}
	set displine 0
    }
    if {[string length $sym]} {
	if {$displine && $inline && !($displine&3)} {
	    p "\n"
	}
	endline
    }
    if {!$inline} {
	p [format "%08x %-15s %-20s" $addr \
		[lindex $sym 0] [lindex $sym 1]]
	set inline 1
	set shownss $shownsection-$sym
    }
}

set stkptr {panic_vars_section-panic: psave_stkptr}
set stack {panic_vars_section-panic: panic_stack}

foreach ss [list $stkptr $stack] { set ccontents($ss) {} }

while {$sectionnum < [llength $sections]} {
    set now_section [expr {$sectionchange - $addr}]
    set now_symbol [expr {$symboladdr - $addr}]
    if {!$now_section && !$insection} {
	set insection 1
	set sectionchange $sectionend
	continue
    }
    if {!$now_symbol} {
	show $symbol
	thingnext symbol
	continue
    }
    if {!$now_section && $insection} {
	if {[string compare $section =SFRs=]} {
	    show { }
	}
	thingnext section
	set insection 0
	set sectionchange $sectionaddr
    }
    set now $now_symbol
    if {$now > $now_section} { set now $now_section }
    if {!$insection} {
	incr addr $now
	continue
    }
    if {$now > $now_max} { set now $now_max }
    show {}
    set bytes [readbytes $addr $now]
    foreach b $bytes {
	set h [format "%02x" [expr {$b & 0xff}]]
	p " $h"
	if {[info exists ccontents($shownss)]} {
	    append ccontents($shownss) $h
	}
	incr addr
    }
    set inline 1
}
endline

set stackdepth 31

proc stack_chkptr {si} {
    global stkptr
    if {$si == $stkptr+1} { p " - - - - -\n" }
}

foreach v {stkptr stack} { set $v $ccontents([set $v]) }

p "\n---------- =Execution Stack= ----------\n"
set stkptr [expr "0x$stkptr & $stackdepth"]

for {set si 1} {$si <= $stackdepth} {incr si} {
    stack_chkptr $si
    for {set ch 2; set se 0x} {$ch >= 0} {incr ch -1} {
	append se [string range $stack \
		[expr ($si-1)*6+$ch*2] [expr ($si-1)*6+$ch*2+1]]
    }
    set symaddr 0; set symsym (start)
    foreach symi $symbolsbylockind(program) {
	if {[lindex $symi 0] > $se} break
	manyset $symi symaddr symsym
    }
    p [format " 0d%02d  %6x = %6x + %s\n" $si $se \
	    [expr {$se-$symaddr}] [join $symsym]]
}
stack_chkptr [expr {$stackdepth+1}]

p "---------- ========== ----------\n"