#!/usr/bin/tclsh8.4

proc debug {s} { puts "$s" }

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" }
}

proc addendlast {v ev evn} {
    upvar #0 $v syms
    lappend syms [list [lindex [lindex $syms end] 0] [list {} (lastsymbol)]]
    lappend syms [list [format 0x%08lx $ev] [list {} $evn]]
}

proc xmit {b} {
    global p
    #debug >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 [expr {$d & 0x0ff}]
	incr n -1
    }
    return $l
}
proc junkrecv {} {
    global p
    fconfigure $p -blocking no
    while {[string length [read $p 1024]]} { }
    fconfigure $p -blocking yes
}

proc selectslave_slave {slave} {
    xmit "$slave ^ 0x30"
}

proc selectslave_s {} {
    global slave
    selectslave_slave $slave
}

proc xmit_slave {slave b} {
    xmit "$b | 0x80"
    selectslave_slave $slave
    recv 1
}

proc xmit_s {b} {
    global slave
    xmit_slave $slave $b
}

proc pause {t} {
    global pause_var
    catch { unset pause_var }
    after $t {set pause_var y}
    vwait pause_var
}

proc setup_m {} { xmit 0; xmit 0; xmit 0; pause 250; junkrecv }
proc setup_s {} { setup_m; xmit 128; pause 256; junkrecv; xmit_s 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
}

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
}


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

proc reset_s {val min max} {
    for {set slave $min} {$slave < $max} {incr slave} {
	xmit_slave $slave $val
    }
}

proc reset_m {arg} {
    if {[regexp {^(\d+)\.(\d+)} $arg min max]} {
    } elseif {[regexp {^(\d+)} $arg max]} {
	set min 1
    } else {
	error "--reset arg $arg wrong"
    }
    setup_m
    reset_s 0x00 $min $max
    reset_s 0x00 $min $max
    reset_s 0x09 $min $max
    xmit 0x09
}

proc badusage {m} {
    set m "bad usage: $m"
    append m {
usage: .../crashread <port> <map-file> <picno>
 pass `-1' for <picno> for test (data memory map) mode only
 pass `reset' for <map-file> to reset pics (then
     <picno> should be <lastpicno+1> or <firstslave>-<lastpicno+1>)
}
    error $m
}

if {[llength $argv] != 3} { badusage "wrong # args" }

set port [lindex $argv 0]
set map [lindex $argv 1]
set slave [lindex $argv 2]

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

if {![string compare reset $map]} {
    reset_m $slave
    exit 0
}

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

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
	    set smap($sym) $addr
	}
	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 symbols {0x00000060 {=udata,!acs=}}
#lappend symbols {0x00000f00 {=SFRs,!acs=}}
lappend symbols {0x00000f60 {=SFRs,acs= {}}}
lappend sections {0x00000f00 {=SFRs=} 0}
#lappend sections {0x00000060 {==========UDATA,!ACS===========} 0}
#lappend sections {0x00000f60 {==========SFRs,ACS===========} 0}

lappend sections [list 0x1000 =END= 0]

proc sortthings {} {
    foreach tosort {sections symbols symbolsbylockind(program)} {
	upvar #0 $tosort ts
	set ts [lsort [set ts]]
    }
}
set readcursor -1

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

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

setup_$ms

proc queue_show {kind value} {
    upvar #0 q_$kind queued
    lappend queued $value
}

proc p_addr_symbol {a s} {
    global inline
    endline
    p [format "%08x %-15s %-20s" $a [lindex $s 0] [lindex $s 1]]
    set inline 1
}

proc endline {} {
    global inline
    if {!$inline} return
    p "\n"
    set inline 0
}

proc do_show {} {
    global addr inline insection q_symbol q_section shownss
    global shownsection
    #debug "do_show [format %x $addr] $insection $q_symbol $q_section"
    if {$inline} { error "do_show inline $addr" }
    foreach s $q_section {
	if {![string compare $s $shownsection]} continue
	p "---------- $s ----------\n"
	set shownsection $s
    }
    set shownss {}
    foreach s $q_symbol {
	p_addr_symbol $addr $s
	set shownss [concat $s]
    }
    #debug "shownss>$shownss<"
    if {!$insection && ![string compare =SFRs= $shownsection]} {
	endline
	p "\n"
	reset_show
	return
    }
    if {![llength $q_symbol]} { p_addr_symbol $addr {} }
    if {!$insection} {
	endline
#	p "------------------------------\n"
	set shownsection {}
    }
    reset_show
}

proc reset_show {} {
    foreach v {q_section q_symbol} {
	global $v
	set $v {}
    }
}

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

if {[info exists smap(misc:\ debugp)] && [info exists smap(misc:\ debug)]} {
    set debugpval [readbytes $smap(misc:\ debugp) 1]
#    puts y1-$debugpval
#    puts y2-$smap(misc:\ debug)
    set debugpaddr [format 0x%08x [expr {$debugpval+$smap(misc:\ debug)}]]
#    puts y3-$debugpaddr
    lappend symbols [list $debugpaddr [list "" (debugp)]]
}

sortthings
addendlast symbolsbylockind(program) 0x8000 (end)

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

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

while {$sectionnum < [llength $sections]} {
    # So what happens at this address ?

    set now_section [expr {$sectionchange - $addr}]
    if {!$now_section && !$insection} {
	queue_show section $section
	set insection 1
	set sectionchange $sectionend
	continue
    }
    if {!$now_section && $insection} {
	thingnext section
	set insection 0
	set sectionchange $sectionaddr
        continue
    }

    set now_symbol [expr {$symboladdr - $addr}]
    if {!$now_symbol} {
	queue_show symbol $symbol
	thingnext symbol
	continue
    }

    # OK, that's all the things that we need to say
    # about this addr.

    # Decide how much to do:
    set now $now_symbol
    if {$now > $now_section} { set now $now_section }

    #debug "now $now"
    do_show

    if {!$insection} {
	incr addr $now
	continue
    }

    while {$now > 0} {
	set nownow $now
	if {$nownow > $now_max} { set nownow $now_max }
	set bytes [readbytes $addr $nownow]
	foreach b $bytes {
	    set h [format "%02x" [expr {$b & 0xff}]]
	    p " $h"
	    if {[info exists ccontents($shownss)]} {
		append ccontents($shownss) $h
	    }
	    incr addr
	}
	incr now -$nownow
    }
    endline
}

set stackdepth 31

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

foreach v {stkptr stack} {
    #debug ">$v|[set $v]|$ccontents([set $v])<"
    set $v $ccontents([set $v])
}

endline
p "---------- =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"