#!/usr/bin/tclsh8.4
#
# usages:
#   ./crashread -p<device> -T <something>.map
#        spits <something>.crat to stdout
#   ./crashread [-i<picno>] [-S<serialport>] <something>.crat
#        spits <something>.crat to stdout

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 0 }  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]} 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]
	lappend symbols [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

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

proc xmit {b} {
    global p
    p $p [format %c $b]
}

proc xmit_s {b} {
    xmit [expr {$b | 0x80}]
    xmit [expr {$slave ^ 0x30}]
}

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

proc selectaddr_m {a} { error }
proc selectaddr_s {a} { error }
proc selectaddr_t {a} { global tsa; set tsa $a }
    
proc readbytes_m {n} { error }
proc readbytes_s {n} { error }
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 readcursor [expr {$addr + $n}]
    }
    return [readbytes_$ms $n]
}

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

setup_$ms

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

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

proc show {sym} {
    global insection section displine addr shownsection inline
    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
    }
}

while {$sectionnum < [llength $sections]} {
    set now_section [expr {$sectionchange - $addr}]
    if {!$now_section && !$insection} {
	set insection 1
	set sectionchange $sectionend
	continue
    }
    set now_symbol [expr {$symboladdr - $addr}]
    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 {
	p [format " %02x" [expr {$b & 0xff}]]
	incr addr
    }
    set inline 1
}