chiark / gitweb /
show debugp in debug section
[trains.git] / detpic / crashread
index 02aeb905e24a17ad6e1c41a715a4af16cfb1fd0d..ce7b86e1f3e9d5fc7303929eeb08170056500685 100755 (executable)
@@ -1,14 +1,10 @@
 #!/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]
+proc debug {s} { puts "$s" }
 
-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
@@ -19,6 +15,203 @@ proc inblk {bre hre} {
     }]
 }
 
+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
@@ -33,15 +226,32 @@ while {[gets $m l] >= 0} {
        incr inblk
     } elseif {[inblk {^Section Info$} \
            {^Section\s+Type\s+Address\s+Location\s+Size\(Bytes\)$}]} {
-       if {[string compare udata [lindex $l 1]]} continue
-       if {[string compare data [lindex $l 3]]} continue
-       set loc [format %08x [lindex $l 2]]
-       set s [lrange $l 0 end]
-       lappend sections [lrange $l 0 end]
+       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$}]} {
-       if {[string compare data [lindex $l 2]]} continue
-       lappend symbols [lrange $l 0 end]
+       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"
@@ -65,6 +275,7 @@ set ok {
 
 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
@@ -73,11 +284,14 @@ while {[gets $h l]>=0} {
     } 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]} {
-               set loc 0x$loc
-               lappend symbols [list $sym $loc data extern x]
-               lappend sections [list SFR sfr $loc data 0x1]
+               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]} {
@@ -87,36 +301,227 @@ while {[gets $h l]>=0} {
     }
 }
 
-puts >$sections<
-puts >$symbols<
+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}
 
-exit 0
+lappend sections [list 0x1000 =END= 0]
 
-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
+proc sortthings {} {
+    foreach tosort {sections symbols symbolsbylockind(program)} {
+       upvar #0 $tosort ts
+       set ts [lsort [set ts]]
+    }
+}
+set readcursor -1
 
-fconfigure $p -blocking yes
+set ms [expr {
+    $slave < 0 ? "t" :
+    $slave ? "s" :
+    "m"
+}]
 
-set ms [expr {$slave ? "m" : "s"}]
+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 {}
 
-proc xmit_s {b} {
-    xmit [expr {$b | 0x80}]
-    xmit [expr {$slave ^ 0x30}] }
+setup_$ms
+
+proc queue_show {kind value} {
+    upvar #0 q_$kind queued
+    lappend queued $value
 }
 
-proc setup_m {} { xmit 0 }
-proc setup_s {} { xmit 0; xmit_s 0 }
+proc p_addr_symbol {a s} {
+    global inline
+    endline
+    p [format "%08x %-15s %-20s" $a [lindex $s 0] [lindex $s 1]]
+    set inline 1
+}
 
-setup_$ms
+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
+}
 
-xmit 0
+proc reset_show {} {
+    foreach v {q_section q_symbol} {
+       global $v
+       set $v {}
+    }
+}
 
-if {$slave} {
-    xmit 0x80
-xmit_slave 0x80
-    xmit 
+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"