detpic/crashread

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