chiark / gitweb /
crashread can print test data
[trains.git] / 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 ? "m" :
131     "s"
132 }]
133
134 proc xmit {b} {
135     global p
136     puts -nonewline $p [format %c $b]
137 }
138
139 proc xmit_s {b} {
140     xmit [expr {$b | 0x80}]
141     xmit [expr {$slave ^ 0x30}]
142 }
143
144 proc setup_m {} { xmit 0 }
145 proc setup_s {} { xmit 0; xmit_s 0 }
146 proc setup_t {} { }
147
148 proc selectaddr_m {a} { error }
149 proc selectaddr_s {a} { error }
150 proc selectaddr_t {a} { global tsa; set tsa $a }
151     
152 proc readbytes_m {n} { error }
153 proc readbytes_s {n} { error }
154 proc readbytes_t {n} {
155     global tsa
156     set l {}
157     while {$n > 0} {
158         lappend l [expr {$tsa - ($tsa >> 8)}]
159         incr tsa
160         incr n -1
161     }
162     return $l
163 }
164
165 set readcursor -1
166
167 proc readbytes {addr n} {
168     global readcursor ms
169     if {$readcursor != $addr} {
170         if {$addr & ~0x0fff} { error "bad addr $addr" }
171         if {$n > (0x1000 - $addr)} { error "bad len $addr+$n" }
172         selectaddr_$ms $addr
173         set readcursor [expr {$addr + $n}]
174     }
175     return [readbytes_$ms $n]
176 }
177
178 proc thingbynum {thing nnum} {
179     upvar #0 ${thing}num num
180     upvar #0 ${thing}s things
181     upvar #0 ${thing}info info
182     upvar #0 ${thing}addr addr
183     upvar #0 ${thing} name
184     set num $nnum
185     if {$num < [llength $things]} {
186         set info [lindex $things $num]
187     } else {
188         set info {0x7fffffff =DUMMY-END= 1}
189     }
190     manyset $info addr name
191     if {![string compare $thing section]} {
192         global sectionsize sectionend
193         set sectionsize [lindex $info 2]
194         set sectionend [expr {$addr + $sectionsize}]
195     }
196 }
197
198 proc thingnext {thing} {
199     upvar #0 ${thing}num num
200     incr num
201     thingbynum $thing $num
202 }
203
204 thingbynum section 0
205 thingbynum symbol 0
206 set shownsection {}
207 set sectionchange 0
208 set insection 0
209 set addr 0
210 set now_max 4
211 set inline -1
212 set displine 0
213
214 setup_$ms
215
216 proc endline {} {
217     global inline displine
218     if {$inline} { puts -nonewline "\n"; incr displine }
219     set inline 0
220 }
221
222 proc show {sym} {
223     global insection section displine addr shownsection inline
224     if {$insection && [string compare $section $shownsection]} {
225         endline
226         puts "---------- $section ----------"
227         set shownsection $section
228         set displine 0
229     } elseif {!$insection && [string length $shownsection]} {
230         endline
231         puts "------------------------------"
232         set shownsection {}
233         set displine 0
234     }
235     if {[string length $sym]} {
236         if {$displine && $inline && !($displine&3)} {
237             puts -nonewline "\n"
238         }
239         endline
240     }
241     if {!$inline} {
242         puts -nonewline [format "%08x %-15s %-20s" $addr \
243                 [lindex $sym 0] [lindex $sym 1]]
244         set inline 1
245     }
246 }
247
248 while {$sectionnum < [llength $sections]} {
249     set now_section [expr {$sectionchange - $addr}]
250     if {!$now_section && !$insection} {
251         set insection 1
252         set sectionchange $sectionend
253         continue
254     }
255     set now_symbol [expr {$symboladdr - $addr}]
256     if {!$now_symbol} {
257         show $symbol
258         thingnext symbol
259         continue
260     }
261     if {!$now_section && $insection} {
262         if {[string compare $section =SFRs=]} {
263             show { }
264         }
265         thingnext section
266         set insection 0
267         set sectionchange $sectionaddr
268     }
269     set now $now_symbol
270     if {$now > $now_section} { set now $now_section }
271     if {!$insection} {
272         incr addr $now
273         continue
274     }
275     if {$now > $now_max} { set now $now_max }
276     show {}
277     set bytes [readbytes $addr $now]
278     foreach b $bytes {
279         puts -nonewline [format " %02x" [expr {$b & 0xff}]]
280         incr addr
281     }
282     set inline 1
283 }