|
1 #! perl |
|
2 # Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies). |
|
3 # All rights reserved. |
|
4 # This component and the accompanying materials are made available |
|
5 # under the terms of the License "Eclipse Public License v1.0" |
|
6 # which accompanies this distribution, and is available |
|
7 # at the URL "http://www.eclipse.org/legal/epl-v10.html". |
|
8 # |
|
9 # Initial Contributors: |
|
10 # Nokia Corporation - initial contribution. |
|
11 # |
|
12 # Contributors: |
|
13 # |
|
14 # Description: |
|
15 # |
|
16 |
|
17 if (@ARGV<1) |
|
18 { |
|
19 #........1.........2.........3.........4.........5.........6.........7..... |
|
20 print <<USAGE_EOF; |
|
21 |
|
22 Usage: |
|
23 printstk.pl d_exc_nnn [romimage.symbol] |
|
24 |
|
25 Given the output of D_EXC, a file d_exc_nnn.txt and d_exc_nnn.stk, it |
|
26 uses the other information to try to put symbolic information against |
|
27 the stack image. |
|
28 |
|
29 USAGE_EOF |
|
30 exit 1; |
|
31 } |
|
32 |
|
33 sub add_object |
|
34 { |
|
35 my ($base, $max, $name) = @_; |
|
36 $address{$base} = [ $base, $max, $name ]; |
|
37 my $key=$base>>20; |
|
38 my $maxkey=$max>>20; |
|
39 while ($key <= $maxkey) # allowing for objects that span the boundary |
|
40 { |
|
41 push @{$addresslist{$key}}, $base; |
|
42 $key+=1; |
|
43 } |
|
44 } |
|
45 |
|
46 my $RomBase = 0xF8000000; |
|
47 my $RomLimit = 0xFFF00000; |
|
48 add_object($RomBase,$RomLimit, "ROM"); |
|
49 |
|
50 # Handle a MAKSYM.LOG file for a ROM |
|
51 # |
|
52 sub read_rom_symbols |
|
53 { |
|
54 my ($romimage)=@_; |
|
55 open ROMSYMBOLS, $romimage or print "Can't open $romimage\n" and return; |
|
56 |
|
57 my $a; |
|
58 my $b; |
|
59 while (my $line = <ROMSYMBOLS>) |
|
60 { |
|
61 if(!($line =~ /^[0-9A-Fa-f]{8}/)) |
|
62 { |
|
63 next; |
|
64 } |
|
65 # 8 bytes for the address |
|
66 |
|
67 $a = substr $line,0,8; |
|
68 if(!($a =~ /[0-9A-Fa-f]{8}/)) |
|
69 { |
|
70 next; |
|
71 } |
|
72 # 4 bytes for the length |
|
73 $b = substr $line,12,4; |
|
74 if(!($b =~ /[0-9A-Fa-f]{4}/)) |
|
75 { |
|
76 next; |
|
77 } |
|
78 # rest of line is symbol |
|
79 my $symbol = substr $line,20; |
|
80 chomp $symbol; |
|
81 |
|
82 my $base=hex($a); |
|
83 my $length=hex($b); |
|
84 if ($base < 0x50000000) |
|
85 { |
|
86 next; # skip this line |
|
87 } |
|
88 if ($length==0xffffffff) |
|
89 { |
|
90 $length=100; # MAKSYM bug? choose a rational length |
|
91 } |
|
92 add_object($base, $base+$length-1, $symbol); |
|
93 } |
|
94 print "ROM Symbols from $romimage\n"; |
|
95 } |
|
96 |
|
97 # Handle MAP file for a non execute-in-place binary |
|
98 # |
|
99 sub read_map_symbols |
|
100 { |
|
101 my ($binary, $binbase)=@_; |
|
102 $binary =~ /([^\\]+)$/; |
|
103 my $basename=$1; |
|
104 if (not open MAPFILE, "$basename.map") |
|
105 { |
|
106 print "Can't open map file for \n$binary.map)\n"; |
|
107 return; |
|
108 } |
|
109 |
|
110 |
|
111 my @maplines; |
|
112 while (<MAPFILE>) |
|
113 { |
|
114 push @maplines, $_; |
|
115 } |
|
116 close MAPFILE; |
|
117 # See if we're dealing with the RVCT output |
|
118 if ($maplines[0] =~ /^ARM Linker/) |
|
119 { |
|
120 # scroll down to the global symbols |
|
121 while ($_ = shift @maplines) |
|
122 { |
|
123 if (/Global Symbols/) |
|
124 { |
|
125 last; |
|
126 } |
|
127 } |
|
128 # .text gets linked at 0x00008000 |
|
129 $imgtext=hex(8000);#start of the text section during linking |
|
130 |
|
131 foreach (@maplines) |
|
132 { |
|
133 # name address ignore size section |
|
134 if (/^\s*(.+)\s*(0x\S+)\s+[^\d]*(\d+)\s+(.*)$/) |
|
135 { |
|
136 my $symbol = $1; |
|
137 my $addr = hex($2); |
|
138 my $size = $3; |
|
139 if ($size > 0)#symbols of the 0 size contain some auxillary information, ignore them |
|
140 { |
|
141 add_object($addr-$imgtext+$binbase,#relocated address of the current symbol |
|
142 $addr-$imgtext+$binbase+$size,#relocated address of the current symbol + size of the current symbol |
|
143 "$binary $symbol"); |
|
144 } |
|
145 } |
|
146 } |
|
147 } |
|
148 else |
|
149 #we are dealing with GCC output |
|
150 { |
|
151 my $imgtext; |
|
152 |
|
153 # Find text section |
|
154 while (($_ = shift @maplines) && !(/^\.text\s+/)) |
|
155 { |
|
156 } |
|
157 |
|
158 /^\.text\s+(\w+)\s+(\w+)/ |
|
159 or die "ERROR: Can't get .text section info for \"$file\"\n"; |
|
160 $imgtext=hex($1);#start of the text section during linking |
|
161 $binbase-=$imgtext; |
|
162 |
|
163 foreach (@maplines) |
|
164 { |
|
165 if (/___CTOR_LIST__/) |
|
166 { |
|
167 last; # end of text section |
|
168 } |
|
169 |
|
170 if (/^\s(\.text)?\s+(0x\w+)\s+(0x\w+)\s+(.*)$/io) |
|
171 { |
|
172 $textlimit = hex($2)+$binbase+hex($3)-1; |
|
173 next; |
|
174 } |
|
175 |
|
176 if (/^\s+(\w+)\s\s+([a-zA-Z_].+)/o) |
|
177 { |
|
178 my $addr = hex($1); |
|
179 my $symbol = $2; |
|
180 add_object($addr+$binbase,#relocated address of the current symbol |
|
181 $textlimit,#limit of the current object section |
|
182 "$binary $symbol"); |
|
183 next; |
|
184 } |
|
185 } |
|
186 } |
|
187 #end of GCC output parsing |
|
188 } |
|
189 |
|
190 # Handle a matched pair of D_EXC output files (.txt and .stk) |
|
191 # |
|
192 sub read_d_exc |
|
193 { |
|
194 my ($name)=@_; |
|
195 |
|
196 $stackbase = 0; |
|
197 open D_EXC, "$name.txt" or die "Can't open $name.txt\n"; |
|
198 |
|
199 binmode D_EXC; |
|
200 read D_EXC, $data, 16; |
|
201 close D_EXC; |
|
202 |
|
203 if ($data =~ /^(..)*.\0.\0/) |
|
204 { |
|
205 # Assuming Unicode |
|
206 close D_EXC; |
|
207 |
|
208 # Charconv won't convert STDIN or write to STDOUT |
|
209 # so we generate an intermediate UTF8 file |
|
210 system "charconv -little -input=unicode $name.txt -output=utf8 $name.utf8.txt"; |
|
211 |
|
212 open D_EXC, "$name.utf8.txt" or die "Can't open $name.utf8.txt\n"; |
|
213 } |
|
214 else |
|
215 { |
|
216 # Assuming ASCII |
|
217 open D_EXC, "$name.txt" or die "Can't open $name.txt\n"; |
|
218 } |
|
219 |
|
220 my $is_eka2_log = 0; |
|
221 |
|
222 while (my $line = <D_EXC>) |
|
223 { |
|
224 |
|
225 if ($line =~ /^EKA2 USER CRASH LOG$/) |
|
226 { |
|
227 $is_eka2_log = 1; |
|
228 next; |
|
229 } |
|
230 |
|
231 # code=1 PC=500f7ff8 FAR=00000042 FSR=e8820013 |
|
232 |
|
233 if ($line =~ /^code=\d PC=(.{8})/) |
|
234 { |
|
235 $is_exc = 1; |
|
236 $fault_pc = hex($1); |
|
237 next; |
|
238 }; |
|
239 |
|
240 # R13svc=81719fc0 R14svc=50031da0 SPSRsvc=60000010 |
|
241 |
|
242 if ($line =~ /^R13svc=(.{8}) R14svc=(.{8}) SPSRsvc=(.{8})/) |
|
243 { |
|
244 $fault_lr = hex($2); |
|
245 next; |
|
246 } |
|
247 |
|
248 # r00=fffffff8 00000000 80000718 80000003 |
|
249 |
|
250 if ($line =~ /^r(\d\d)=(.{8}) (.{8}) (.{8}) (.{8})/) |
|
251 { |
|
252 $registers{$1} = $line; |
|
253 if ($1 == 12) |
|
254 { |
|
255 $activesp = hex($3); |
|
256 $user_pc = hex($5); |
|
257 $user_lr = hex($4); |
|
258 } |
|
259 next; |
|
260 } |
|
261 |
|
262 # User Stack 03900000-03905ffb |
|
263 # EKA1 format deliberately broken (was /^Stack.*/) to catch version problems |
|
264 |
|
265 if ($line =~ /^User Stack (.{8})-(.{8})/) |
|
266 { |
|
267 $stackbase = hex($1); |
|
268 add_object($stackbase,hex($2), "Stack"); |
|
269 next; |
|
270 } |
|
271 |
|
272 # fff00000-fff00fff C:\foo\bar.dll |
|
273 |
|
274 if ($line =~ /^(.{8})-(.{8}) (.+)/) |
|
275 { |
|
276 next if ($RomBase <= hex($1) && hex($1) < $RomLimit); # skip ROM XIP binaries |
|
277 add_object(hex($1), hex($2), $3); |
|
278 read_map_symbols($3, hex($1)); |
|
279 } |
|
280 } |
|
281 close D_EXC; |
|
282 |
|
283 die "$name.txt is not a valid EKA2 crash log" unless $is_eka2_log; |
|
284 |
|
285 if ($stackbase == 0) |
|
286 { |
|
287 die "couldn't find stack information in $name.txt\n"; |
|
288 } |
|
289 |
|
290 die "couldn't find stack pointer in $name.txt\n" unless $activesp != 0; |
|
291 $activesp -= $stackbase; |
|
292 |
|
293 # Read in the binary dump of the stack |
|
294 |
|
295 open STACK, "$name.stk" or die "Can't open $name.stk\n"; |
|
296 print "Stack Data from $name.stk\n"; |
|
297 |
|
298 binmode STACK; |
|
299 while (read STACK, $data, 4) |
|
300 { |
|
301 unshift @stack, (unpack "V", $data); |
|
302 } |
|
303 $stackptr = 0; |
|
304 } |
|
305 |
|
306 # Handle the captured text output from the Kernel debugger |
|
307 # |
|
308 sub read_debugger |
|
309 { |
|
310 my ($name)=@_; |
|
311 |
|
312 open DEBUGFILE, "$name" or die "Can't open $name\n"; |
|
313 print "Kernel Debugger session from $name\n"; |
|
314 |
|
315 # stuff which should be inferred from "$name" |
|
316 |
|
317 $stackbase = 0x81C00000; |
|
318 $stackmax = 0x81C01DC0; |
|
319 $activesp = 0x81c01bc4-$stackbase; |
|
320 add_object($stackbase,0x81C01FFF, "Stack"); |
|
321 |
|
322 while (my $line = <DEBUGFILE>) |
|
323 { |
|
324 if ($line =~ /^(\w{8}): ((\w\w ){16})/) |
|
325 { |
|
326 my $addr = hex($1); |
|
327 if ($addr < $stackbase || $addr > $stackmax) |
|
328 { |
|
329 next; |
|
330 } |
|
331 if (@stack == 0) |
|
332 { |
|
333 if ($addr != $stackbase) |
|
334 { |
|
335 printf "Missing stack data for %x-%x - fill with 0x29\n", $stackbase, $addr-1; |
|
336 @stack = (0x29292929) x (($addr-$stackbase)/4); |
|
337 } |
|
338 } |
|
339 unshift @stack, reverse (unpack "V4", (pack "H2"x16, (split / /,$2))); |
|
340 } |
|
341 } |
|
342 $stackptr = 0; |
|
343 } |
|
344 |
|
345 read_d_exc(@ARGV[0]); |
|
346 if (@ARGV>1) |
|
347 { |
|
348 read_rom_symbols(@ARGV[1]); |
|
349 } |
|
350 |
|
351 # We've accumulated the ranges of objects indexed by start address, |
|
352 # with a companion list of addresses subdivided by the leading byte |
|
353 # Now sort them numerically... |
|
354 |
|
355 sub numerically { $a <=> $b } |
|
356 foreach my $key (keys %addresslist) |
|
357 { |
|
358 @{$addresslist{$key}} = sort numerically @{$addresslist{$key}}; |
|
359 } |
|
360 |
|
361 # Off we go, reading the stack! |
|
362 |
|
363 sub skip_unused |
|
364 { |
|
365 my $skipped=0; |
|
366 while (@stack) |
|
367 { |
|
368 my $word=(pop @stack); |
|
369 if ($word!=0x29292929) |
|
370 { |
|
371 push @stack, $word; |
|
372 last; |
|
373 } |
|
374 $skipped += 4; |
|
375 } |
|
376 $stackptr += $skipped; |
|
377 return $skipped; |
|
378 } |
|
379 |
|
380 sub lookup_addr |
|
381 { |
|
382 my ($word) = @_; |
|
383 |
|
384 # Optimization - try looking up the address directly |
|
385 |
|
386 my $base; |
|
387 my $max; |
|
388 my $name; |
|
389 if(defined $address{$word}) { |
|
390 ($base, $max, $name) = @{$address{$word}}; |
|
391 } |
|
392 if (!(defined $base)) |
|
393 { |
|
394 my $key=$word>>20; |
|
395 my $regionbase; |
|
396 foreach $base (@{$addresslist{$key}}) |
|
397 { |
|
398 if ($base <= $word) |
|
399 { |
|
400 $regionbase = $base; |
|
401 next; |
|
402 } |
|
403 if ($base > $word) |
|
404 { |
|
405 last; |
|
406 } |
|
407 } |
|
408 if(defined $regionbase) |
|
409 { |
|
410 ($base, $max, $name) = @{$address{$regionbase}}; |
|
411 } |
|
412 } |
|
413 if (defined $base && defined $max && $base <= $word && $max >= $word) |
|
414 { |
|
415 my $data = pack "V", $word; |
|
416 $data =~ tr [\040-\177]/./c; |
|
417 return sprintf "%08x %4s %s + 0x%x", $word, $data, $name, $word - $base; |
|
418 } |
|
419 return ""; |
|
420 } |
|
421 |
|
422 sub match_addr |
|
423 # |
|
424 # Try matching one of the named areas in the addresslist |
|
425 # |
|
426 { |
|
427 my $word = (pop @stack); |
|
428 |
|
429 if ($word < 1024*1024) |
|
430 { |
|
431 push @stack, $word; |
|
432 return 0; |
|
433 } |
|
434 |
|
435 my $result = lookup_addr($word); |
|
436 if ($result ne "") |
|
437 { |
|
438 print "$result\n"; |
|
439 $stackptr+=4; |
|
440 return 1; |
|
441 } |
|
442 push @stack, $word; |
|
443 return 0; |
|
444 } |
|
445 |
|
446 sub match_tbuf8 |
|
447 # |
|
448 # Try matching a TBuf8 |
|
449 # 0x3000LLLL 0x0000MMMM data |
|
450 # |
|
451 { |
|
452 if (scalar @stack <3) |
|
453 { |
|
454 return 0; # too short |
|
455 } |
|
456 my $word = (pop @stack); |
|
457 my $maxlen = (pop @stack); |
|
458 |
|
459 my $len = $word & 0x0ffff; |
|
460 my $type = ($word >> 16) & 0x0ffff; |
|
461 if ( $type != 0x3000 || $maxlen <= $len || $maxlen > 4* scalar @stack |
|
462 || ($stackptr < $activesp && $stackptr + $maxlen + 8 > $activesp)) |
|
463 { |
|
464 push @stack, $maxlen; |
|
465 push @stack, $word; |
|
466 return 0; # wrong type, or invalid looking sizes, or out of date |
|
467 } |
|
468 |
|
469 printf "TBuf8<%d>, length %d\n", $maxlen, $len; |
|
470 $stackptr += 8; |
|
471 |
|
472 my $string=""; |
|
473 while ($maxlen > 0) |
|
474 { |
|
475 $string .= pack "V", pop @stack; |
|
476 $maxlen -= 4; |
|
477 $stackptr += 4; |
|
478 } |
|
479 if ($len==0) |
|
480 { |
|
481 print "\n"; |
|
482 return 1; |
|
483 } |
|
484 my $line = substr($string,0,$len); |
|
485 my @buf = unpack "C*", $line; |
|
486 $line =~ tr [\040-\177]/./c; |
|
487 printf "\n %s", $line; |
|
488 while ($len > 0) |
|
489 { |
|
490 my $datalen = 16; |
|
491 if ($datalen > $len) |
|
492 { |
|
493 $datalen = $len; |
|
494 } |
|
495 $len -= $datalen; |
|
496 printf "\n "; |
|
497 while ($datalen > 0) |
|
498 { |
|
499 my $char = shift @buf; |
|
500 printf "%02x ", $char; |
|
501 $datalen -= 1; |
|
502 } |
|
503 } |
|
504 printf "\n\n"; |
|
505 return 1; |
|
506 } |
|
507 |
|
508 # Skip the unused part of the stack |
|
509 |
|
510 skip_unused; |
|
511 printf "High watermark = %04x\n", $stackptr; |
|
512 |
|
513 # process the interesting bit! |
|
514 |
|
515 my $printed_current_sp = 0; |
|
516 while (@stack) |
|
517 { |
|
518 if (!$printed_current_sp && $stackptr >= $activesp) |
|
519 { |
|
520 printf "\n >>>> current user stack pointer >>>>\n\n"; |
|
521 |
|
522 print $registers{"00"}; |
|
523 print $registers{"04"}; |
|
524 print $registers{"08"}; |
|
525 print $registers{"12"}; |
|
526 |
|
527 if ($is_exc && $user_pc != $fault_pc) |
|
528 { |
|
529 print "\nWARNING: A kernel-side exception occured but this script\n"; |
|
530 print "is currently limited to user stack analysis. Sorry.\n"; |
|
531 my $result = lookup_addr($fault_pc); |
|
532 if ($result ne "") |
|
533 { |
|
534 print "Kernel PC = $result\n"; |
|
535 } |
|
536 $result = lookup_addr($fault_lr); |
|
537 if ($result ne "") |
|
538 { |
|
539 print "Kernel LR = $result\n"; |
|
540 } |
|
541 print "\n"; |
|
542 } |
|
543 |
|
544 my $result = lookup_addr($user_pc); |
|
545 if ($result ne "") |
|
546 { |
|
547 print "User PC = $result\n"; |
|
548 } |
|
549 $result = lookup_addr($user_lr); |
|
550 if ($result ne "") |
|
551 { |
|
552 print "User LR = $result\n"; |
|
553 } |
|
554 printf "\n >>>> current user stack pointer >>>>\n\n"; |
|
555 $printed_current_sp = 1; |
|
556 } |
|
557 |
|
558 printf "%04x ", $stackptr; |
|
559 |
|
560 match_tbuf8() and next; |
|
561 match_addr() and next; |
|
562 |
|
563 $word = pop @stack; |
|
564 $data = pack "V", $word; |
|
565 $data =~ tr [\040-\177]/./c; |
|
566 printf "%08x %4s ", $word, $data; |
|
567 $stackptr += 4; |
|
568 |
|
569 if ($word == 0x29292929) |
|
570 { |
|
571 $skipped = skip_unused; |
|
572 if ($skipped != 0) |
|
573 { |
|
574 printf "\n...."; |
|
575 } |
|
576 printf "\n"; |
|
577 next; |
|
578 } |
|
579 |
|
580 # Try matching $word against the known addresses of things |
|
581 printf "\n"; |
|
582 } |
|
583 |
|
584 |