detpic/crashread

   1 #!/usr/bin/tclsh8.4
   2
   3 if {[llength $argv] != 3} { error "need args: serial port, map file, picno" }
   4 set port [lindex $argv 0]
   5 set map [lindex $argv 1]
   6 set slave [lindex $argv 2]
   7
   8 set m [open $map]
   9 set block preable
  10 set headings unknown
  11 set inblk 3
  12
  13 proc manyset {list args} {
  14     foreach val $list var $args { upvar 1 $var my; set my $val }
  15 }
  16
  17 proc inblk {bre hre} {
  18     global inblk block headings
  19     return [expr {
  20         $inblk==3 &&
  21         [regexp $bre $block] &&
  22         [regexp $hre $headings]
  23     }]
  24 }
  25
  26 proc wantlockind {lockind thing l} {
  27     switch -exact $lockind  program { return -1 }  data { return 1 }  \
  28         default { error "unknown $thing lockind $lockind in $l" }
  29 }
  30
  31 while {[gets $m l] >= 0} {
  32     if {![regexp {\S} $l]} {
  33         set inblk 0
  34         set section unknown
  35         set headings n/a
  36     } elseif {$inblk==0 && [regexp {^\s+(\S.*\S)\s*$} $l dummy block]} {
  37         incr inblk
  38     } elseif {$inblk==1} {
  39         set headings [string trim $l]
  40         incr inblk
  41     } elseif {$inblk==2 && [regexp {^[- \t]+$} $l]} {
  42         incr inblk
  43     } elseif {[inblk {^Section Info$} \
  44             {^Section\s+Type\s+Address\s+Location\s+Size\(Bytes\)$}]} {
  45         manyset $l sec type addr lockind size
  46         switch -exact $type  code { continue }  udata { } \
  47                 default { error "unknown section type $type in $l" }
  48         if {[wantlockind $lockind section $l]<=0} continue
  49         set addr [format 0x%08x $addr]
  50         lappend sections [list $addr $sec [format 0x%08x $size]]
  51     } elseif {[inblk {^Symbols$} \
  52             {^Name\s+Address\s+Location\s+Storage\s+File$}]} {
  53         manyset $l sym addr lockind storage file
  54         if {![wantlockind $lockind symbol $l]} continue
  55         switch -exact $storage {
  56             extern { set sym [list {} $sym] }
  57             static {
  58                 regexp {^(.*)\.asm$} $file dummy file
  59                 set sym [list $file: $sym]
  60             }
  61             default { error "unknown storage $storage in $l" }
  62         }
  63         set addr [format 0x%08x $addr]
  64         if {[string compare $lockind data]} {
  65             set sv symbolsbylockind($lockind)
  66         } else {
  67             set sv symbols
  68         }
  69         lappend $sv [list $addr $sym]
  70     } elseif {$inblk==3} {
  71     } else {
  72         error "unknown $inblk <$block> <$headings> $l"
  73     }
  74 }
  75
  76 set ok {
  77     INTCON* FSR2*
  78     OSCCON LVDCON WDTCON RCON
  79     T1CON T2CON
  80     SSPADD SSPSTAT SSPCON1 SSPCON2
  81     ADRESH ADRESL ADCON*
  82     CCPR1* CCP1CON
  83     ECCPR1* ECCP1DEL ECCPAS
  84     CMCON CVRCON T3CON
  85     SPBRG TXSTA RXSTA
  86     EEADR EEDATA
  87     IPR* PIR* PIE*
  88     TRIS* LAT*
  89 }
  90
  91 set h [open /usr/share/gputils/header/p18f458.inc]
  92 set section unknown
  93 set lastaddr -1
  94 while {[gets $h l]>=0} {
  95     if {[regexp {^\;\-\-+\s+(\S.*\S)\s+\-\-+$} $l dummy section]} {
  96         continue
  97     } elseif {![regexp {^Register Files$} $section]} {
  98         continue
  99     } elseif {[regexp -nocase \
 100             {^([a-z][a-z0-9]*)\s+equ\s+h\'0(f[0-9a-f]{2})\'\s*$} \
 101             $l dummy sym loc]} {
 102         set addr [format 0x%08x 0x$loc]
 103         foreach pat $ok {
 104             if {[string match $pat $sym]} {
 105                 if {$addr != $lastaddr} {
 106                     lappend sections [list $addr =SFRs= 0x1]
 107                     set lastaddr $addr
 108                 }
 109                 lappend symbols [list $addr [list SFR $sym]]
 110             }
 111         }
 112     } elseif {[regexp -nocase {^\;\s*reserved} $l]} {
 113     } elseif {![regexp {\S} $l]} {
 114     } else {
 115         error "unknown <$section> $l"
 116     }
 117 }
 118
 119 lappend sections [list 0x1000 =END= 0]
 120 set sections [lsort $sections]
 121 set symbols [lsort $symbols]
 122
 123 set p [open $port {RDWR NONBLOCK} 0]
 124 exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
 125         -ctlecho -echo -echoe -echok -echonl -iexten -isig \
 126         -icanon -icrnl \
 127         9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
 128         -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
 129
 130 fconfigure $p -blocking yes -buffering none \
 131         -translation binary -encoding binary
 132
 133 set ms [expr {
 134     $slave < 0 ? "t" :
 135     $slave ? "s" :
 136     "m"
 137 }]
 138
 139 proc xmit {b} {
 140     global p
 141 #puts stderr >xmit|$b<
 142     set b [expr $b]
 143     set c [binary format c* $b]
 144     puts -nonewline $p [format %c $b]
 145 }
 146 proc recv {n} {
 147     global p
 148     set l {}
 149     while {$n > 0} {
 150         set c [read $p 1]
 151         binary scan $c c* d
 152         if {![llength $d]} { error "comms eof" }
 153         lappend l $d
 154         incr n -1
 155     }
 156     return $l
 157 }
 158
 159 proc selectslave_s {} {
 160     global slave
 161     xmit "$slave ^ 0x30"
 162 }
 163
 164 proc xmit_s {b} {
 165     xmit "$b | 0x80"
 166     selectslave_s
 167     recv 1
 168 }
 169
 170 proc setup_m {} { xmit 0 }
 171 proc setup_s {} { xmit 0; xmit_s 0 }
 172 proc setup_t {} { }
 173
 174 proc selectaddr_ms {xmit a} {
 175     $xmit "($a >> 6) | 0x40"
 176     $xmit "($a & 0x3c) | 0x40"
 177 }
 178 proc selectaddr_m {a} { selectaddr_ms xmit $a }
 179 proc selectaddr_s {a} { selectaddr_ms xmit_s $a }
 180 proc selectaddr_t {a} { global tsa; set tsa $a }
 181
 182 proc readbytes_m {n} {
 183     xmit "$n | 0x10"
 184     return [recv $n]
 185 }
 186 proc readbytes_s {n} {
 187     xmit $n
 188     selectslave_s
 189     return [recv $n]
 190 }
 191
 192 proc readbytes_t {n} {
 193     global tsa
 194     set l {}
 195     while {$n > 0} {
 196         lappend l [expr {$tsa - ($tsa >> 8)}]
 197         incr tsa
 198         incr n -1
 199     }
 200     return $l
 201 }
 202
 203 set readcursor -1
 204
 205 proc readbytes {addr n} {
 206     global readcursor ms
 207     if {$readcursor != $addr} {
 208         if {$addr & ~0x0fff} { error "bad addr $addr" }
 209         if {$n > (0x1000 - $addr)} { error "bad len $addr+$n" }
 210         selectaddr_$ms $addr
 211     }
 212     set r [readbytes_$ms $n]
 213     set readcursor [expr {$addr + $n}]
 214     return $r
 215 }
 216
 217 proc thingbynum {thing nnum} {
 218     upvar #0 ${thing}num num
 219     upvar #0 ${thing}s things
 220     upvar #0 ${thing}info info
 221     upvar #0 ${thing}addr addr
 222     upvar #0 ${thing} name
 223     set num $nnum
 224     if {$num < [llength $things]} {
 225         set info [lindex $things $num]
 226     } else {
 227         set info {0x7fffffff =DUMMY-END= 1}
 228     }
 229     manyset $info addr name
 230     if {![string compare $thing section]} {
 231         global sectionsize sectionend
 232         set sectionsize [lindex $info 2]
 233         set sectionend [expr {$addr + $sectionsize}]
 234     }
 235 }
 236
 237 proc thingnext {thing} {
 238     upvar #0 ${thing}num num
 239     incr num
 240     thingbynum $thing $num
 241 }
 242
 243 thingbynum section 0
 244 thingbynum symbol 0
 245 set shownsection {}
 246 set sectionchange 0
 247 set insection 0
 248 set addr 0
 249 set now_max 4
 250 set inline -1
 251 set displine 0
 252
 253 proc p {s} { puts -nonewline $s }
 254
 255 setup_$ms
 256
 257 proc endline {} {
 258     global inline displine
 259     if {$inline} { p "\n"; incr displine }
 260     set inline 0
 261 }
 262
 263 proc show {sym} {
 264     global insection section displine addr shownsection inline shownss
 265     set showsectionend 0
 266     if {$insection && [string compare $section $shownsection]} {
 267         endline
 268         p "---------- $section ----------\n"
 269         set shownsection $section
 270         set displine 0
 271     } elseif {!$insection && [string length $shownsection]} {
 272         endline
 273         p "------------------------------\n"
 274         set shownsection {}
 275         set displine 0
 276     }
 277     if {[string length $sym]} {
 278         if {$displine && $inline && !($displine&3)} {
 279             p "\n"
 280         }
 281         endline
 282     }
 283     if {!$inline} {
 284         p [format "%08x %-15s %-20s" $addr \
 285                 [lindex $sym 0] [lindex $sym 1]]
 286         set inline 1
 287         set shownss $shownsection-$sym
 288     }
 289 }
 290
 291 set stkptr {panic_vars_section-panic: psave_stkptr}
 292 set stack {panic_vars_section-panic: panic_stack}
 293
 294 foreach ss [list $stkptr $stack] { set ccontents($ss) {} }
 295
 296 while {$sectionnum < [llength $sections]} {
 297     set now_section [expr {$sectionchange - $addr}]
 298     set now_symbol [expr {$symboladdr - $addr}]
 299     if {!$now_section && !$insection} {
 300         set insection 1
 301         set sectionchange $sectionend
 302         continue
 303     }
 304     if {!$now_symbol} {
 305         show $symbol
 306         thingnext symbol
 307         continue
 308     }
 309     if {!$now_section && $insection} {
 310         if {[string compare $section =SFRs=]} {
 311             show { }
 312         }
 313         thingnext section
 314         set insection 0
 315         set sectionchange $sectionaddr
 316     }
 317     set now $now_symbol
 318     if {$now > $now_section} { set now $now_section }
 319     if {!$insection} {
 320         incr addr $now
 321         continue
 322     }
 323     if {$now > $now_max} { set now $now_max }
 324     show {}
 325     set bytes [readbytes $addr $now]
 326     foreach b $bytes {
 327         set h [format "%02x" [expr {$b & 0xff}]]
 328         p " $h"
 329         if {[info exists ccontents($shownss)]} {
 330             append ccontents($shownss) $h
 331         }
 332         incr addr
 333     }
 334     set inline 1
 335 }
 336 endline
 337
 338 set stackdepth 31
 339
 340 proc stack_chkptr {si} {
 341     global stkptr
 342     if {$si == $stkptr+1} { p " - - - - -\n" }
 343 }
 344
 345 foreach v {stkptr stack} { set $v $ccontents([set $v]) }
 346
 347 p "\n---------- =Execution Stack= ----------\n"
 348 set stkptr [expr "0x$stkptr & $stackdepth"]
 349
 350 for {set si 1} {$si <= $stackdepth} {incr si} {
 351     stack_chkptr $si
 352     for {set ch 2; set se 0x} {$ch >= 0} {incr ch -1} {
 353         append se [string range $stack \
 354                 [expr ($si-1)*6+$ch*2] [expr ($si-1)*6+$ch*2+1]]
 355     }
 356     set symi {0 (start)}
 357     foreach symi $symbolsbylockind(program) {
 358         if {[lindex $symi 0] > $se} break
 359     }
 360     manyset $symi symaddr symsym
 361     p [format " 0d%02d  %6x = %6x + %s\n" $si $se \
 362             [expr {$se-$symaddr}] $symsym]
 363 }
 364 stack_chkptr [expr {$stackdepth+1}]
 365
 366 p "---------- ========== ----------\n"