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 0 }  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]} 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         lappend symbols [list $addr $sym]
  65     } elseif {$inblk==3} {
  66     } else {
  67         error "unknown $inblk <$block> <$headings> $l"
  68     }
  69 }
  70
  71 set ok {
  72     INTCON* FSR2*
  73     OSCCON LVDCON WDTCON RCON
  74     T1CON T2CON
  75     SSPADD SSPSTAT SSPCON1 SSPCON2
  76     ADRESH ADRESL ADCON*
  77     CCPR1* CCP1CON
  78     ECCPR1* ECCP1DEL ECCPAS
  79     CMCON CVRCON T3CON
  80     SPBRG TXSTA RXSTA
  81     EEADR EEDATA
  82     IPR* PIR* PIE*
  83     TRIS* LAT*
  84 }
  85
  86 set h [open /usr/share/gputils/header/p18f458.inc]
  87 set section unknown
  88 set lastaddr -1
  89 while {[gets $h l]>=0} {
  90     if {[regexp {^\;\-\-+\s+(\S.*\S)\s+\-\-+$} $l dummy section]} {
  91         continue
  92     } elseif {![regexp {^Register Files$} $section]} {
  93         continue
  94     } elseif {[regexp -nocase \
  95             {^([a-z][a-z0-9]*)\s+equ\s+h\'0(f[0-9a-f]{2})\'\s*$} \
  96             $l dummy sym loc]} {
  97         set addr [format 0x%08x 0x$loc]
  98         foreach pat $ok {
  99             if {[string match $pat $sym]} {
 100                 if {$addr != $lastaddr} {
 101                     lappend sections [list $addr =SFRs= 0x1]
 102                     set lastaddr $addr
 103                 }
 104                 lappend symbols [list $addr [list SFR $sym]]
 105             }
 106         }
 107     } elseif {[regexp -nocase {^\;\s*reserved} $l]} {
 108     } elseif {![regexp {\S} $l]} {
 109     } else {
 110         error "unknown <$section> $l"
 111     }
 112 }
 113
 114 lappend sections [list 0x1000 =END= 0]
 115 set sections [lsort $sections]
 116 set symbols [lsort $symbols]
 117
 118 set p [open $port {RDWR NONBLOCK} 0]
 119 exec stty -F $port min 1 time 0 -istrip -ocrnl -onlcr -onocr -opost \
 120         -ctlecho -echo -echoe -echok -echonl -iexten -isig \
 121         -icanon -icrnl \
 122         9600 clocal cread -crtscts -hup -parenb cs8 -cstopb \
 123         -ixoff bs0 cr0 ff0 nl0 -ofill -olcuc
 124
 125 fconfigure $p -blocking yes -buffering none \
 126         -translation binary -encoding binary
 127
 128 set ms [expr {
 129     $slave < 0 ? "t" :
 130     $slave ? "s" :
 131     "m"
 132 }]
 133
 134 proc xmit {b} {
 135     global p
 136 #puts stderr >xmit|$b<
 137     set b [expr $b]
 138     set c [binary format c* $b]
 139     puts -nonewline $p [format %c $b]
 140 }
 141 proc recv {n} {
 142     global p
 143     set l {}
 144     while {$n > 0} {
 145         set c [read $p 1]
 146         binary scan $c c* d
 147         if {![llength $d]} { error "comms eof" }
 148         lappend l $d
 149         incr n -1
 150     }
 151     return $l
 152 }
 153
 154 proc selectslave_s {} {
 155     global slave
 156     xmit "$slave ^ 0x30"
 157 }
 158
 159 proc xmit_s {b} {
 160     xmit "$b | 0x80"
 161     selectslave_s
 162     recv 1
 163 }
 164
 165 proc setup_m {} { xmit 0 }
 166 proc setup_s {} { xmit 0; xmit_s 0 }
 167 proc setup_t {} { }
 168
 169 proc selectaddr_ms {xmit a} {
 170     $xmit "($a >> 6) | 0x40"
 171     $xmit "($a & 0x3c) | 0x40"
 172 }
 173 proc selectaddr_m {a} { selectaddr_ms xmit $a }
 174 proc selectaddr_s {a} { selectaddr_ms xmit_s $a }
 175 proc selectaddr_t {a} { global tsa; set tsa $a }
 176
 177 proc readbytes_m {n} {
 178     xmit "$n | 0x10"
 179     return [recv $n]
 180 }
 181 proc readbytes_s {n} {
 182     xmit $n
 183     selectslave_s
 184     return [recv $n]
 185 }
 186
 187 proc readbytes_t {n} {
 188     global tsa
 189     set l {}
 190     while {$n > 0} {
 191         lappend l [expr {$tsa - ($tsa >> 8)}]
 192         incr tsa
 193         incr n -1
 194     }
 195     return $l
 196 }
 197
 198 set readcursor -1
 199
 200 proc readbytes {addr n} {
 201     global readcursor ms
 202     if {$readcursor != $addr} {
 203         if {$addr & ~0x0fff} { error "bad addr $addr" }
 204         if {$n > (0x1000 - $addr)} { error "bad len $addr+$n" }
 205         selectaddr_$ms $addr
 206     }
 207     set r [readbytes_$ms $n]
 208     set readcursor [expr {$addr + $n}]
 209     return $r
 210 }
 211
 212 proc thingbynum {thing nnum} {
 213     upvar #0 ${thing}num num
 214     upvar #0 ${thing}s things
 215     upvar #0 ${thing}info info
 216     upvar #0 ${thing}addr addr
 217     upvar #0 ${thing} name
 218     set num $nnum
 219     if {$num < [llength $things]} {
 220         set info [lindex $things $num]
 221     } else {
 222         set info {0x7fffffff =DUMMY-END= 1}
 223     }
 224     manyset $info addr name
 225     if {![string compare $thing section]} {
 226         global sectionsize sectionend
 227         set sectionsize [lindex $info 2]
 228         set sectionend [expr {$addr + $sectionsize}]
 229     }
 230 }
 231
 232 proc thingnext {thing} {
 233     upvar #0 ${thing}num num
 234     incr num
 235     thingbynum $thing $num
 236 }
 237
 238 thingbynum section 0
 239 thingbynum symbol 0
 240 set shownsection {}
 241 set sectionchange 0
 242 set insection 0
 243 set addr 0
 244 set now_max 4
 245 set inline -1
 246 set displine 0
 247
 248 proc p {s} { puts -nonewline $s }
 249
 250 setup_$ms
 251
 252 proc endline {} {
 253     global inline displine
 254     if {$inline} { p "\n"; incr displine }
 255     set inline 0
 256 }
 257
 258 proc show {sym} {
 259     global insection section displine addr shownsection inline
 260     if {$insection && [string compare $section $shownsection]} {
 261         endline
 262         p "---------- $section ----------\n"
 263         set shownsection $section
 264         set displine 0
 265     } elseif {!$insection && [string length $shownsection]} {
 266         endline
 267         p "------------------------------\n"
 268         set shownsection {}
 269         set displine 0
 270     }
 271     if {[string length $sym]} {
 272         if {$displine && $inline && !($displine&3)} {
 273             p "\n"
 274         }
 275         endline
 276     }
 277     if {!$inline} {
 278         p [format "%08x %-15s %-20s" $addr \
 279                 [lindex $sym 0] [lindex $sym 1]]
 280         set inline 1
 281     }
 282 }
 283
 284 while {$sectionnum < [llength $sections]} {
 285     set now_section [expr {$sectionchange - $addr}]
 286     if {!$now_section && !$insection} {
 287         set insection 1
 288         set sectionchange $sectionend
 289         continue
 290     }
 291     set now_symbol [expr {$symboladdr - $addr}]
 292     if {!$now_symbol} {
 293         show $symbol
 294         thingnext symbol
 295         continue
 296     }
 297     if {!$now_section && $insection} {
 298         if {[string compare $section =SFRs=]} {
 299             show { }
 300         }
 301         thingnext section
 302         set insection 0
 303         set sectionchange $sectionaddr
 304     }
 305     set now $now_symbol
 306     if {$now > $now_section} { set now $now_section }
 307     if {!$insection} {
 308         incr addr $now
 309         continue
 310     }
 311     if {$now > $now_max} { set now $now_max }
 312     show {}
 313     set bytes [readbytes $addr $now]
 314     foreach b $bytes {
 315         p [format " %02x" [expr {$b & 0xff}]]
 316         incr addr
 317     }
 318     set inline 1
 319 }
 320 endline