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 debug {s} { puts "$s" }
  14
  15 proc manyset {list args} {
  16     foreach val $list var $args { upvar 1 $var my; set my $val }
  17 }
  18
  19 proc inblk {bre hre} {
  20     global inblk block headings
  21     return [expr {
  22         $inblk==3 &&
  23         [regexp $bre $block] &&
  24         [regexp $hre $headings]
  25     }]
  26 }
  27
  28 proc wantlockind {lockind thing l} {
  29     switch -exact $lockind  program { return -1 }  data { return 1 }  \
  30         default { error "unknown $thing lockind $lockind in $l" }
  31 }
  32
  33 while {[gets $m l] >= 0} {
  34     if {![regexp {\S} $l]} {
  35         set inblk 0
  36         set section unknown
  37         set headings n/a
  38     } elseif {$inblk==0 && [regexp {^\s+(\S.*\S)\s*$} $l dummy block]} {
  39         incr inblk
  40     } elseif {$inblk==1} {
  41         set headings [string trim $l]
  42         incr inblk
  43     } elseif {$inblk==2 && [regexp {^[- \t]+$} $l]} {
  44         incr inblk
  45     } elseif {[inblk {^Section Info$} \
  46             {^Section\s+Type\s+Address\s+Location\s+Size\(Bytes\)$}]} {
  47         manyset $l sec type addr lockind size
  48         switch -exact $type  code { continue }  udata { } \
  49                 default { error "unknown section type $type in $l" }
  50         if {[wantlockind $lockind section $l]<=0} continue
  51         set addr [format 0x%08x $addr]
  52         lappend sections [list $addr $sec [format 0x%08x $size]]
  53     } elseif {[inblk {^Symbols$} \
  54             {^Name\s+Address\s+Location\s+Storage\s+File$}]} {
  55         manyset $l sym addr lockind storage file
  56         if {![wantlockind $lockind symbol $l]} continue
  57         switch -exact $storage {
  58             extern { set sym [list {} $sym] }
  59             static {
  60                 regexp {^(.*)\.asm$} $file dummy file
  61                 set sym [list $file: $sym]
  62             }
  63             default { error "unknown storage $storage in $l" }
  64         }
  65         set addr [format 0x%08x $addr]
  66         if {[string compare $lockind data]} {
  67             set sv symbolsbylockind($lockind)
  68         } else {
  69             set sv symbols
  70         }
  71         lappend $sv [list $addr $sym]
  72     } elseif {$inblk==3} {
  73     } else {
  74         error "unknown $inblk <$block> <$headings> $l"
  75     }
  76 }
  77
  78 set ok {
  79     INTCON* FSR2*
  80     OSCCON LVDCON WDTCON RCON
  81     T1CON T2CON
  82     SSPADD SSPSTAT SSPCON1 SSPCON2
  83     ADRESH ADRESL ADCON*
  84     CCPR1* CCP1CON
  85     ECCPR1* ECCP1DEL ECCPAS
  86     CMCON CVRCON T3CON
  87     SPBRG TXSTA RXSTA
  88     EEADR EEDATA
  89     IPR* PIR* PIE*
  90     TRIS* LAT*
  91 }
  92
  93 set h [open /usr/share/gputils/header/p18f458.inc]
  94 set section unknown
  95 set lastaddr -1
  96 while {[gets $h l]>=0} {
  97     if {[regexp {^\;\-\-+\s+(\S.*\S)\s+\-\-+$} $l dummy section]} {
  98         continue
  99     } elseif {![regexp {^Register Files$} $section]} {
 100         continue
 101     } elseif {[regexp -nocase \
 102             {^([a-z][a-z0-9]*)\s+equ\s+h\'0(f[0-9a-f]{2})\'\s*$} \
 103             $l dummy sym loc]} {
 104         set addr [format 0x%08x 0x$loc]
 105         foreach pat $ok {
 106             if {[string match $pat $sym]} {
 107                 if {$addr != $lastaddr} {
 108                     lappend sections [list $addr =SFRs= 0x1]
 109                     set lastaddr $addr
 110                 }
 111                 lappend symbols [list $addr [list SFR $sym]]
 112             }
 113         }
 114     } elseif {[regexp -nocase {^\;\s*reserved} $l]} {
 115     } elseif {![regexp {\S} $l]} {
 116     } else {
 117         error "unknown <$section> $l"
 118     }
 119 }
 120
 121 lappend symbols {0x00000060 {=udata,!acs=}}
 122 #lappend symbols {0x00000f00 {=SFRs,!acs=}}
 123 lappend symbols {0x00000f60 {=SFRs,acs= {}}}
 124 lappend sections {0x00000f00 {=SFRs=} 0}
 125 #lappend sections {0x00000060 {==========UDATA,!ACS===========} 0}
 126 #lappend sections {0x00000f60 {==========SFRs,ACS===========} 0}
 127
 128 lappend sections [list 0x1000 =END= 0]
 129 foreach tosort {sections symbols symbolsbylockind(program)} {
 130     set $tosort [lsort [set $tosort]]
 131 }
 132
 133 proc addendlast {v ev evn} {
 134     upvar #0 $v syms
 135     lappend syms [list [lindex [lindex $syms end] 0] [list {} (lastsymbol)]]
 136     lappend syms [list [format 0x%08lx $ev] [list {} $evn]]
 137 }
 138
 139 addendlast symbolsbylockind(program) 0x8000 (end)
 140
 141 set p [open $port {RDWR NONBLOCK} 0]
 142 exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
 143         -ctlecho -echo -echoe -echok -echonl -iexten -isig \
 144         -icanon -icrnl \
 145         9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
 146         -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
 147
 148 fconfigure $p -blocking yes -buffering none \
 149         -translation binary -encoding binary
 150
 151 fconfigure stdout -buffering none
 152
 153 set ms [expr {
 154     $slave < 0 ? "t" :
 155     $slave ? "s" :
 156     "m"
 157 }]
 158
 159 proc xmit {b} {
 160     global p
 161     #debug >xmit|$b<
 162     set b [expr $b]
 163     set c [binary format c* $b]
 164     puts -nonewline $p [format %c $b]
 165 }
 166 proc recv {n} {
 167     global p
 168     set l {}
 169     while {$n > 0} {
 170         set c [read $p 1]
 171         binary scan $c c* d
 172         if {![llength $d]} { error "comms eof" }
 173         lappend l $d
 174         incr n -1
 175     }
 176     return $l
 177 }
 178 proc junkrecv {} {
 179     global p
 180     fconfigure $p -blocking no
 181     while {[string length [read $p 1024]]} { }
 182     fconfigure $p -blocking yes
 183 }
 184
 185 proc selectslave_s {} {
 186     global slave
 187     xmit "$slave ^ 0x30"
 188 }
 189
 190 proc xmit_s {b} {
 191     xmit "$b | 0x80"
 192     selectslave_s
 193     recv 1
 194 }
 195
 196 proc pause {t} {
 197     global pause_var
 198     catch { unset pause_var }
 199     after $t {set pause_var y}
 200     vwait pause_var
 201 }
 202
 203 proc setup_m {} { xmit 0; xmit 0; xmit 0; pause 250; junkrecv }
 204 proc setup_s {} { setup_m; xmit_s 0; xmit_s 0 }
 205 proc setup_t {} { }
 206
 207 proc selectaddr_ms {xmit a} {
 208     $xmit "($a >> 6) | 0x40"
 209     $xmit "($a & 0x3f) | 0x40"
 210 }
 211 proc selectaddr_m {a} { selectaddr_ms xmit $a }
 212 proc selectaddr_s {a} { selectaddr_ms xmit_s $a }
 213 proc selectaddr_t {a} { global tsa; set tsa $a }
 214
 215 proc readbytes_m {n} {
 216     xmit "$n | 0x10"
 217     return [recv $n]
 218 }
 219 proc readbytes_s {n} {
 220     xmit $n
 221     selectslave_s
 222     return [recv $n]
 223 }
 224
 225 proc readbytes_t {n} {
 226     global tsa
 227     set l {}
 228     while {$n > 0} {
 229         lappend l [expr {$tsa - ($tsa >> 8)}]
 230         incr tsa
 231         incr n -1
 232     }
 233     return $l
 234 }
 235
 236 set readcursor -1
 237
 238 proc readbytes {addr n} {
 239     global readcursor ms
 240     if {$readcursor != $addr} {
 241         if {$addr & ~0x0fff} { error "bad addr $addr" }
 242         if {$n > (0x1000 - $addr)} { error "bad len $addr+$n" }
 243         selectaddr_$ms $addr
 244     }
 245     set r [readbytes_$ms $n]
 246     set readcursor [expr {$addr + $n}]
 247     return $r
 248 }
 249
 250 proc thingbynum {thing nnum} {
 251     upvar #0 ${thing}num num
 252     upvar #0 ${thing}s things
 253     upvar #0 ${thing}info info
 254     upvar #0 ${thing}addr addr
 255     upvar #0 ${thing} name
 256     set num $nnum
 257     if {$num < [llength $things]} {
 258         set info [lindex $things $num]
 259     } else {
 260         set info {0x7fffffff =DUMMY-END= 1}
 261     }
 262     manyset $info addr name
 263     if {![string compare $thing section]} {
 264         global sectionsize sectionend
 265         set sectionsize [lindex $info 2]
 266         set sectionend [expr {$addr + $sectionsize}]
 267     }
 268 }
 269
 270 proc thingnext {thing} {
 271     upvar #0 ${thing}num num
 272     incr num
 273     thingbynum $thing $num
 274 }
 275
 276 thingbynum section 0
 277 thingbynum symbol 0
 278 set shownsection {}
 279 set sectionchange 0
 280 set insection 0
 281 set addr 0
 282 set now_max 4
 283 set displine 0
 284 set inline 0
 285 set shownsection {}
 286
 287 proc p {s} { puts -nonewline $s }
 288
 289 setup_$ms
 290
 291 proc queue_show {kind value} {
 292     upvar #0 q_$kind queued
 293     lappend queued $value
 294 }
 295
 296 proc p_addr_symbol {a s} {
 297     global inline
 298     endline
 299     p [format "%08x %-15s %-20s" $a [lindex $s 0] [lindex $s 1]]
 300     set inline 1
 301 }
 302
 303 proc endline {} {
 304     global inline
 305     if {!$inline} return
 306     p "\n"
 307     set inline 0
 308 }
 309
 310 proc do_show {} {
 311     global addr inline insection q_symbol q_section shownss
 312     global shownsection
 313     #debug "do_show [format %x $addr] $insection $q_symbol $q_section"
 314     if {$inline} { error "do_show inline $addr" }
 315     foreach s $q_section {
 316         if {![string compare $s $shownsection]} continue
 317         p "---------- $s ----------\n"
 318         set shownsection $s
 319     }
 320     set shownss {}
 321     foreach s $q_symbol {
 322         p_addr_symbol $addr $s
 323         set shownss [concat $s]
 324     }
 325     #debug "shownss>$shownss<"
 326     if {!$insection && ![string compare =SFRs= $shownsection]} {
 327         endline
 328         p "\n"
 329         reset_show
 330         return
 331     }
 332     if {![llength $q_symbol]} { p_addr_symbol $addr {} }
 333     if {!$insection} {
 334         endline
 335 #       p "------------------------------\n"
 336         set shownsection {}
 337     }
 338     reset_show
 339 }
 340
 341 proc reset_show {} {
 342     foreach v {q_section q_symbol} {
 343         global $v
 344         set $v {}
 345     }
 346 }
 347
 348 proc show {sym} {
 349     global insection section displine addr shownsection inline shownss
 350     set showsectionend 0
 351     if {$insection && [string compare $section $shownsection]} {
 352         endline
 353         set shownsection $section
 354         set displine 0
 355     } elseif {!$insection && [string length $shownsection]} {
 356         endline
 357         set shownsection {}
 358         set displine 0
 359     }
 360     if {[string length $sym]} {
 361         if {$displine && $inline && !($displine&3)} {
 362             p "\n"
 363         }
 364         endline
 365     }
 366     if {!$inline} {
 367         set inline 1
 368         set shownss $shownsection-$sym
 369     }
 370 }
 371
 372 set stkptr {panic: psave_stkptr}
 373 set stack {panic: panic_stack}
 374
 375 reset_show
 376 foreach ss [list $stkptr $stack] { set ccontents($ss) {} }
 377
 378 while {$sectionnum < [llength $sections]} {
 379     # So what happens at this address ?
 380
 381     set now_section [expr {$sectionchange - $addr}]
 382     if {!$now_section && !$insection} {
 383         queue_show section $section
 384         set insection 1
 385         set sectionchange $sectionend
 386         continue
 387     }
 388     if {!$now_section && $insection} {
 389         thingnext section
 390         set insection 0
 391         set sectionchange $sectionaddr
 392         continue
 393     }
 394
 395     set now_symbol [expr {$symboladdr - $addr}]
 396     if {!$now_symbol} {
 397         queue_show symbol $symbol
 398         thingnext symbol
 399         continue
 400     }
 401
 402     # OK, that's all the things that we need to say
 403     # about this addr.
 404
 405     # Decide how much to do:
 406     set now $now_symbol
 407     if {$now > $now_section} { set now $now_section }
 408
 409     #debug "now $now"
 410     do_show
 411
 412     if {!$insection} {
 413         incr addr $now
 414         continue
 415     }
 416
 417     while {$now > 0} {
 418         set nownow $now
 419         if {$nownow > $now_max} { set nownow $now_max }
 420         set bytes [readbytes $addr $nownow]
 421         foreach b $bytes {
 422             set h [format "%02x" [expr {$b & 0xff}]]
 423             p " $h"
 424             if {[info exists ccontents($shownss)]} {
 425                 append ccontents($shownss) $h
 426             }
 427             incr addr
 428         }
 429         incr now -$nownow
 430     }
 431     endline
 432 }
 433
 434 set stackdepth 31
 435
 436 proc stack_chkptr {si} {
 437     global stkptr
 438     if {$si == $stkptr+1} { p " - - - - -\n" }
 439 }
 440
 441 foreach v {stkptr stack} {
 442     #debug ">$v|[set $v]|$ccontents([set $v])<"
 443     set $v $ccontents([set $v])
 444 }
 445
 446 endline
 447 p "---------- =Execution Stack= ----------\n"
 448 set stkptr [expr "0x$stkptr & $stackdepth"]
 449
 450 for {set si 1} {$si <= $stackdepth} {incr si} {
 451     stack_chkptr $si
 452     for {set ch 2; set se 0x} {$ch >= 0} {incr ch -1} {
 453         append se [string range $stack \
 454                 [expr ($si-1)*6+$ch*2] [expr ($si-1)*6+$ch*2+1]]
 455     }
 456     set symaddr 0; set symsym (start)
 457     foreach symi $symbolsbylockind(program) {
 458         if {[lindex $symi 0] > $se} break
 459         manyset $symi symaddr symsym
 460     }
 461     p [format " 0d%02d  %6x = %6x + %s\n" $si $se \
 462             [expr {$se-$symaddr}] [join $symsym]]
 463 }
 464 stack_chkptr [expr {$stackdepth+1}]
 465
 466 p "---------- ========== ----------\n"