detpic/crashread

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