1.1 --- /dev/null Thu Jan 01 00:00:00 1970 +0000
1.2 +++ b/os/kernelhwsrv/kerneltest/e32utils/d_exc/printstk.pl Fri Jun 15 03:10:57 2012 +0200
1.3 @@ -0,0 +1,584 @@
1.4 +#! perl
1.5 +# Copyright (c) 2004-2009 Nokia Corporation and/or its subsidiary(-ies).
1.6 +# All rights reserved.
1.7 +# This component and the accompanying materials are made available
1.8 +# under the terms of the License "Eclipse Public License v1.0"
1.9 +# which accompanies this distribution, and is available
1.10 +# at the URL "http://www.eclipse.org/legal/epl-v10.html".
1.11 +#
1.12 +# Initial Contributors:
1.13 +# Nokia Corporation - initial contribution.
1.14 +#
1.15 +# Contributors:
1.16 +#
1.17 +# Description:
1.18 +#
1.19 +
1.20 +if (@ARGV<1)
1.21 + {
1.22 +#........1.........2.........3.........4.........5.........6.........7.....
1.23 + print <<USAGE_EOF;
1.24 +
1.25 +Usage:
1.26 + printstk.pl d_exc_nnn [romimage.symbol]
1.27 +
1.28 +Given the output of D_EXC, a file d_exc_nnn.txt and d_exc_nnn.stk, it
1.29 +uses the other information to try to put symbolic information against
1.30 +the stack image.
1.31 +
1.32 +USAGE_EOF
1.33 + exit 1;
1.34 + }
1.35 +
1.36 +sub add_object
1.37 + {
1.38 + my ($base, $max, $name) = @_;
1.39 + $address{$base} = [ $base, $max, $name ];
1.40 + my $key=$base>>20;
1.41 + my $maxkey=$max>>20;
1.42 + while ($key <= $maxkey) # allowing for objects that span the boundary
1.43 + {
1.44 + push @{$addresslist{$key}}, $base;
1.45 + $key+=1;
1.46 + }
1.47 + }
1.48 +
1.49 +my $RomBase = 0xF8000000;
1.50 +my $RomLimit = 0xFFF00000;
1.51 +add_object($RomBase,$RomLimit, "ROM");
1.52 +
1.53 +# Handle a MAKSYM.LOG file for a ROM
1.54 +#
1.55 +sub read_rom_symbols
1.56 + {
1.57 + my ($romimage)=@_;
1.58 + open ROMSYMBOLS, $romimage or print "Can't open $romimage\n" and return;
1.59 +
1.60 + my $a;
1.61 + my $b;
1.62 + while (my $line = <ROMSYMBOLS>)
1.63 + {
1.64 + if(!($line =~ /^[0-9A-Fa-f]{8}/))
1.65 + {
1.66 + next;
1.67 + }
1.68 + # 8 bytes for the address
1.69 +
1.70 + $a = substr $line,0,8;
1.71 + if(!($a =~ /[0-9A-Fa-f]{8}/))
1.72 + {
1.73 + next;
1.74 + }
1.75 + # 4 bytes for the length
1.76 + $b = substr $line,12,4;
1.77 + if(!($b =~ /[0-9A-Fa-f]{4}/))
1.78 + {
1.79 + next;
1.80 + }
1.81 + # rest of line is symbol
1.82 + my $symbol = substr $line,20;
1.83 + chomp $symbol;
1.84 +
1.85 + my $base=hex($a);
1.86 + my $length=hex($b);
1.87 + if ($base < 0x50000000)
1.88 + {
1.89 + next; # skip this line
1.90 + }
1.91 + if ($length==0xffffffff)
1.92 + {
1.93 + $length=100; # MAKSYM bug? choose a rational length
1.94 + }
1.95 + add_object($base, $base+$length-1, $symbol);
1.96 + }
1.97 + print "ROM Symbols from $romimage\n";
1.98 + }
1.99 +
1.100 +# Handle MAP file for a non execute-in-place binary
1.101 +#
1.102 +sub read_map_symbols
1.103 + {
1.104 + my ($binary, $binbase)=@_;
1.105 + $binary =~ /([^\\]+)$/;
1.106 + my $basename=$1;
1.107 + if (not open MAPFILE, "$basename.map")
1.108 + {
1.109 + print "Can't open map file for \n$binary.map)\n";
1.110 + return;
1.111 + }
1.112 +
1.113 +
1.114 + my @maplines;
1.115 + while (<MAPFILE>)
1.116 + {
1.117 + push @maplines, $_;
1.118 + }
1.119 + close MAPFILE;
1.120 +# See if we're dealing with the RVCT output
1.121 + if ($maplines[0] =~ /^ARM Linker/)
1.122 + {
1.123 + # scroll down to the global symbols
1.124 + while ($_ = shift @maplines)
1.125 + {
1.126 + if (/Global Symbols/)
1.127 + {
1.128 + last;
1.129 + }
1.130 + }
1.131 + # .text gets linked at 0x00008000
1.132 + $imgtext=hex(8000);#start of the text section during linking
1.133 +
1.134 + foreach (@maplines)
1.135 + {
1.136 + # name address ignore size section
1.137 + if (/^\s*(.+)\s*(0x\S+)\s+[^\d]*(\d+)\s+(.*)$/)
1.138 + {
1.139 + my $symbol = $1;
1.140 + my $addr = hex($2);
1.141 + my $size = $3;
1.142 + if ($size > 0)#symbols of the 0 size contain some auxillary information, ignore them
1.143 + {
1.144 + add_object($addr-$imgtext+$binbase,#relocated address of the current symbol
1.145 + $addr-$imgtext+$binbase+$size,#relocated address of the current symbol + size of the current symbol
1.146 + "$binary $symbol");
1.147 + }
1.148 + }
1.149 + }
1.150 + }
1.151 + else
1.152 +#we are dealing with GCC output
1.153 + {
1.154 + my $imgtext;
1.155 +
1.156 + # Find text section
1.157 + while (($_ = shift @maplines) && !(/^\.text\s+/))
1.158 + {
1.159 + }
1.160 +
1.161 + /^\.text\s+(\w+)\s+(\w+)/
1.162 + or die "ERROR: Can't get .text section info for \"$file\"\n";
1.163 + $imgtext=hex($1);#start of the text section during linking
1.164 + $binbase-=$imgtext;
1.165 +
1.166 + foreach (@maplines)
1.167 + {
1.168 + if (/___CTOR_LIST__/)
1.169 + {
1.170 + last; # end of text section
1.171 + }
1.172 +
1.173 + if (/^\s(\.text)?\s+(0x\w+)\s+(0x\w+)\s+(.*)$/io)
1.174 + {
1.175 + $textlimit = hex($2)+$binbase+hex($3)-1;
1.176 + next;
1.177 + }
1.178 +
1.179 + if (/^\s+(\w+)\s\s+([a-zA-Z_].+)/o)
1.180 + {
1.181 + my $addr = hex($1);
1.182 + my $symbol = $2;
1.183 + add_object($addr+$binbase,#relocated address of the current symbol
1.184 + $textlimit,#limit of the current object section
1.185 + "$binary $symbol");
1.186 + next;
1.187 + }
1.188 + }
1.189 + }
1.190 +#end of GCC output parsing
1.191 + }
1.192 +
1.193 +# Handle a matched pair of D_EXC output files (.txt and .stk)
1.194 +#
1.195 +sub read_d_exc
1.196 + {
1.197 + my ($name)=@_;
1.198 +
1.199 + $stackbase = 0;
1.200 + open D_EXC, "$name.txt" or die "Can't open $name.txt\n";
1.201 +
1.202 + binmode D_EXC;
1.203 + read D_EXC, $data, 16;
1.204 + close D_EXC;
1.205 +
1.206 + if ($data =~ /^(..)*.\0.\0/)
1.207 + {
1.208 + # Assuming Unicode
1.209 + close D_EXC;
1.210 +
1.211 + # Charconv won't convert STDIN or write to STDOUT
1.212 + # so we generate an intermediate UTF8 file
1.213 + system "charconv -little -input=unicode $name.txt -output=utf8 $name.utf8.txt";
1.214 +
1.215 + open D_EXC, "$name.utf8.txt" or die "Can't open $name.utf8.txt\n";
1.216 + }
1.217 + else
1.218 + {
1.219 + # Assuming ASCII
1.220 + open D_EXC, "$name.txt" or die "Can't open $name.txt\n";
1.221 + }
1.222 +
1.223 + my $is_eka2_log = 0;
1.224 +
1.225 + while (my $line = <D_EXC>)
1.226 + {
1.227 +
1.228 + if ($line =~ /^EKA2 USER CRASH LOG$/)
1.229 + {
1.230 + $is_eka2_log = 1;
1.231 + next;
1.232 + }
1.233 +
1.234 + # code=1 PC=500f7ff8 FAR=00000042 FSR=e8820013
1.235 +
1.236 + if ($line =~ /^code=\d PC=(.{8})/)
1.237 + {
1.238 + $is_exc = 1;
1.239 + $fault_pc = hex($1);
1.240 + next;
1.241 + };
1.242 +
1.243 + # R13svc=81719fc0 R14svc=50031da0 SPSRsvc=60000010
1.244 +
1.245 + if ($line =~ /^R13svc=(.{8}) R14svc=(.{8}) SPSRsvc=(.{8})/)
1.246 + {
1.247 + $fault_lr = hex($2);
1.248 + next;
1.249 + }
1.250 +
1.251 + # r00=fffffff8 00000000 80000718 80000003
1.252 +
1.253 + if ($line =~ /^r(\d\d)=(.{8}) (.{8}) (.{8}) (.{8})/)
1.254 + {
1.255 + $registers{$1} = $line;
1.256 + if ($1 == 12)
1.257 + {
1.258 + $activesp = hex($3);
1.259 + $user_pc = hex($5);
1.260 + $user_lr = hex($4);
1.261 + }
1.262 + next;
1.263 + }
1.264 +
1.265 + # User Stack 03900000-03905ffb
1.266 + # EKA1 format deliberately broken (was /^Stack.*/) to catch version problems
1.267 +
1.268 + if ($line =~ /^User Stack (.{8})-(.{8})/)
1.269 + {
1.270 + $stackbase = hex($1);
1.271 + add_object($stackbase,hex($2), "Stack");
1.272 + next;
1.273 + }
1.274 +
1.275 + # fff00000-fff00fff C:\foo\bar.dll
1.276 +
1.277 + if ($line =~ /^(.{8})-(.{8}) (.+)/)
1.278 + {
1.279 + next if ($RomBase <= hex($1) && hex($1) < $RomLimit); # skip ROM XIP binaries
1.280 + add_object(hex($1), hex($2), $3);
1.281 + read_map_symbols($3, hex($1));
1.282 + }
1.283 + }
1.284 + close D_EXC;
1.285 +
1.286 + die "$name.txt is not a valid EKA2 crash log" unless $is_eka2_log;
1.287 +
1.288 + if ($stackbase == 0)
1.289 + {
1.290 + die "couldn't find stack information in $name.txt\n";
1.291 + }
1.292 +
1.293 + die "couldn't find stack pointer in $name.txt\n" unless $activesp != 0;
1.294 + $activesp -= $stackbase;
1.295 +
1.296 + # Read in the binary dump of the stack
1.297 +
1.298 + open STACK, "$name.stk" or die "Can't open $name.stk\n";
1.299 + print "Stack Data from $name.stk\n";
1.300 +
1.301 + binmode STACK;
1.302 + while (read STACK, $data, 4)
1.303 + {
1.304 + unshift @stack, (unpack "V", $data);
1.305 + }
1.306 + $stackptr = 0;
1.307 + }
1.308 +
1.309 +# Handle the captured text output from the Kernel debugger
1.310 +#
1.311 +sub read_debugger
1.312 + {
1.313 + my ($name)=@_;
1.314 +
1.315 + open DEBUGFILE, "$name" or die "Can't open $name\n";
1.316 + print "Kernel Debugger session from $name\n";
1.317 +
1.318 + # stuff which should be inferred from "$name"
1.319 +
1.320 + $stackbase = 0x81C00000;
1.321 + $stackmax = 0x81C01DC0;
1.322 + $activesp = 0x81c01bc4-$stackbase;
1.323 + add_object($stackbase,0x81C01FFF, "Stack");
1.324 +
1.325 + while (my $line = <DEBUGFILE>)
1.326 + {
1.327 + if ($line =~ /^(\w{8}): ((\w\w ){16})/)
1.328 + {
1.329 + my $addr = hex($1);
1.330 + if ($addr < $stackbase || $addr > $stackmax)
1.331 + {
1.332 + next;
1.333 + }
1.334 + if (@stack == 0)
1.335 + {
1.336 + if ($addr != $stackbase)
1.337 + {
1.338 + printf "Missing stack data for %x-%x - fill with 0x29\n", $stackbase, $addr-1;
1.339 + @stack = (0x29292929) x (($addr-$stackbase)/4);
1.340 + }
1.341 + }
1.342 + unshift @stack, reverse (unpack "V4", (pack "H2"x16, (split / /,$2)));
1.343 + }
1.344 + }
1.345 + $stackptr = 0;
1.346 + }
1.347 +
1.348 +read_d_exc(@ARGV[0]);
1.349 +if (@ARGV>1)
1.350 + {
1.351 + read_rom_symbols(@ARGV[1]);
1.352 + }
1.353 +
1.354 +# We've accumulated the ranges of objects indexed by start address,
1.355 +# with a companion list of addresses subdivided by the leading byte
1.356 +# Now sort them numerically...
1.357 +
1.358 +sub numerically { $a <=> $b }
1.359 +foreach my $key (keys %addresslist)
1.360 + {
1.361 + @{$addresslist{$key}} = sort numerically @{$addresslist{$key}};
1.362 + }
1.363 +
1.364 +# Off we go, reading the stack!
1.365 +
1.366 +sub skip_unused
1.367 + {
1.368 + my $skipped=0;
1.369 + while (@stack)
1.370 + {
1.371 + my $word=(pop @stack);
1.372 + if ($word!=0x29292929)
1.373 + {
1.374 + push @stack, $word;
1.375 + last;
1.376 + }
1.377 + $skipped += 4;
1.378 + }
1.379 + $stackptr += $skipped;
1.380 + return $skipped;
1.381 + }
1.382 +
1.383 +sub lookup_addr
1.384 +{
1.385 + my ($word) = @_;
1.386 +
1.387 + # Optimization - try looking up the address directly
1.388 +
1.389 + my $base;
1.390 + my $max;
1.391 + my $name;
1.392 + if(defined $address{$word}) {
1.393 + ($base, $max, $name) = @{$address{$word}};
1.394 + }
1.395 + if (!(defined $base))
1.396 + {
1.397 + my $key=$word>>20;
1.398 + my $regionbase;
1.399 + foreach $base (@{$addresslist{$key}})
1.400 + {
1.401 + if ($base <= $word)
1.402 + {
1.403 + $regionbase = $base;
1.404 + next;
1.405 + }
1.406 + if ($base > $word)
1.407 + {
1.408 + last;
1.409 + }
1.410 + }
1.411 + if(defined $regionbase)
1.412 + {
1.413 + ($base, $max, $name) = @{$address{$regionbase}};
1.414 + }
1.415 + }
1.416 + if (defined $base && defined $max && $base <= $word && $max >= $word)
1.417 + {
1.418 + my $data = pack "V", $word;
1.419 + $data =~ tr [\040-\177]/./c;
1.420 + return sprintf "%08x %4s %s + 0x%x", $word, $data, $name, $word - $base;
1.421 + }
1.422 + return "";
1.423 +}
1.424 +
1.425 +sub match_addr
1.426 +#
1.427 +# Try matching one of the named areas in the addresslist
1.428 +#
1.429 +{
1.430 + my $word = (pop @stack);
1.431 +
1.432 + if ($word < 1024*1024)
1.433 + {
1.434 + push @stack, $word;
1.435 + return 0;
1.436 + }
1.437 +
1.438 + my $result = lookup_addr($word);
1.439 + if ($result ne "")
1.440 + {
1.441 + print "$result\n";
1.442 + $stackptr+=4;
1.443 + return 1;
1.444 + }
1.445 + push @stack, $word;
1.446 + return 0;
1.447 + }
1.448 +
1.449 +sub match_tbuf8
1.450 +#
1.451 +# Try matching a TBuf8
1.452 +# 0x3000LLLL 0x0000MMMM data
1.453 +#
1.454 + {
1.455 + if (scalar @stack <3)
1.456 + {
1.457 + return 0; # too short
1.458 + }
1.459 + my $word = (pop @stack);
1.460 + my $maxlen = (pop @stack);
1.461 +
1.462 + my $len = $word & 0x0ffff;
1.463 + my $type = ($word >> 16) & 0x0ffff;
1.464 + if ( $type != 0x3000 || $maxlen <= $len || $maxlen > 4* scalar @stack
1.465 + || ($stackptr < $activesp && $stackptr + $maxlen + 8 > $activesp))
1.466 + {
1.467 + push @stack, $maxlen;
1.468 + push @stack, $word;
1.469 + return 0; # wrong type, or invalid looking sizes, or out of date
1.470 + }
1.471 +
1.472 + printf "TBuf8<%d>, length %d\n", $maxlen, $len;
1.473 + $stackptr += 8;
1.474 +
1.475 + my $string="";
1.476 + while ($maxlen > 0)
1.477 + {
1.478 + $string .= pack "V", pop @stack;
1.479 + $maxlen -= 4;
1.480 + $stackptr += 4;
1.481 + }
1.482 + if ($len==0)
1.483 + {
1.484 + print "\n";
1.485 + return 1;
1.486 + }
1.487 + my $line = substr($string,0,$len);
1.488 + my @buf = unpack "C*", $line;
1.489 + $line =~ tr [\040-\177]/./c;
1.490 + printf "\n %s", $line;
1.491 + while ($len > 0)
1.492 + {
1.493 + my $datalen = 16;
1.494 + if ($datalen > $len)
1.495 + {
1.496 + $datalen = $len;
1.497 + }
1.498 + $len -= $datalen;
1.499 + printf "\n ";
1.500 + while ($datalen > 0)
1.501 + {
1.502 + my $char = shift @buf;
1.503 + printf "%02x ", $char;
1.504 + $datalen -= 1;
1.505 + }
1.506 + }
1.507 + printf "\n\n";
1.508 + return 1;
1.509 + }
1.510 +
1.511 +# Skip the unused part of the stack
1.512 +
1.513 +skip_unused;
1.514 +printf "High watermark = %04x\n", $stackptr;
1.515 +
1.516 +# process the interesting bit!
1.517 +
1.518 +my $printed_current_sp = 0;
1.519 +while (@stack)
1.520 + {
1.521 + if (!$printed_current_sp && $stackptr >= $activesp)
1.522 + {
1.523 + printf "\n >>>> current user stack pointer >>>>\n\n";
1.524 +
1.525 + print $registers{"00"};
1.526 + print $registers{"04"};
1.527 + print $registers{"08"};
1.528 + print $registers{"12"};
1.529 +
1.530 + if ($is_exc && $user_pc != $fault_pc)
1.531 + {
1.532 + print "\nWARNING: A kernel-side exception occured but this script\n";
1.533 + print "is currently limited to user stack analysis. Sorry.\n";
1.534 + my $result = lookup_addr($fault_pc);
1.535 + if ($result ne "")
1.536 + {
1.537 + print "Kernel PC = $result\n";
1.538 + }
1.539 + $result = lookup_addr($fault_lr);
1.540 + if ($result ne "")
1.541 + {
1.542 + print "Kernel LR = $result\n";
1.543 + }
1.544 + print "\n";
1.545 + }
1.546 +
1.547 + my $result = lookup_addr($user_pc);
1.548 + if ($result ne "")
1.549 + {
1.550 + print "User PC = $result\n";
1.551 + }
1.552 + $result = lookup_addr($user_lr);
1.553 + if ($result ne "")
1.554 + {
1.555 + print "User LR = $result\n";
1.556 + }
1.557 + printf "\n >>>> current user stack pointer >>>>\n\n";
1.558 + $printed_current_sp = 1;
1.559 + }
1.560 +
1.561 + printf "%04x ", $stackptr;
1.562 +
1.563 + match_tbuf8() and next;
1.564 + match_addr() and next;
1.565 +
1.566 + $word = pop @stack;
1.567 + $data = pack "V", $word;
1.568 + $data =~ tr [\040-\177]/./c;
1.569 + printf "%08x %4s ", $word, $data;
1.570 + $stackptr += 4;
1.571 +
1.572 + if ($word == 0x29292929)
1.573 + {
1.574 + $skipped = skip_unused;
1.575 + if ($skipped != 0)
1.576 + {
1.577 + printf "\n....";
1.578 + }
1.579 + printf "\n";
1.580 + next;
1.581 + }
1.582 +
1.583 + # Try matching $word against the known addresses of things
1.584 + printf "\n";
1.585 + }
1.586 +
1.587 +