kerneltest/e32utils/trace/btrace_syslock.pl
changeset 9 96e5fb8b040d
equal deleted inserted replaced
-1:000000000000 9:96e5fb8b040d
       
     1 # Copyright (c) 2007-2009 Nokia Corporation and/or its subsidiary(-ies).
       
     2 # All rights reserved.
       
     3 # This component and the accompanying materials are made available
       
     4 # under the terms of the License "Eclipse Public License v1.0"
       
     5 # which accompanies this distribution, and is available
       
     6 # at the URL "http://www.eclipse.org/legal/epl-v10.html".
       
     7 #
       
     8 # Initial Contributors:
       
     9 # Nokia Corporation - initial contribution.
       
    10 #
       
    11 # Contributors:
       
    12 #
       
    13 # Description:
       
    14 # e32utils\trace\btrace_syslock.pl
       
    15 # Process runtests btrace log file to determine the maximum time the system
       
    16 # lock was held for.
       
    17 # Example commands to generate a runtests btrace log file with system lock 
       
    18 # tracing analysis when running e32test.auto.bat and 10MB btrace buffer:
       
    19 # 1 - btrace -f4,17 -m1 -b10480
       
    20 # 2 - runtests e32test.auto.bat -a OR use 
       
    21 # btrace -a
       
    22 # after running what ever is being tested
       
    23 # Syntax:
       
    24 # perl btrace_syslock.pl <inputfile> [<symbolfile> [<maxsymbols]]
       
    25 # If <maxsymbols> is given, this is how many of the last (i.e. slowest)
       
    26 # results to look up in the symbol file.  Defaults to 1.
       
    27 # 
       
    28 #
       
    29 
       
    30 use strict;
       
    31 
       
    32 # Unbuffer stderr
       
    33 my $oldfh = select(STDERR); $| = 1; select($oldfh);
       
    34 
       
    35 print STDERR "\nTHIS TOOL IS UNOFFICIAL, UNSUPPORTED AND SUBJECT TO CHANGE WITHOUT NOTICE!\n\n";
       
    36 
       
    37 
       
    38 my $usage = "$0: usage: perl $0 <logfile> [<symbolfile> [<maxsymbols>]]\n";
       
    39 
       
    40 my ($infile, $symbolfile, $howmany) = @ARGV;
       
    41 
       
    42 die($usage) if !($infile && -f $infile) || ($symbolfile && ! -f $symbolfile);
       
    43 
       
    44 my $symbols = new SymbolTable($symbolfile);
       
    45 
       
    46 open(my $in, "<", $infile) || die("$0: $infile: $!\n");
       
    47 
       
    48 my @wanted = ();
       
    49 
       
    50 my $lockinfo;
       
    51 my $testnames = {};
       
    52 my $bufferfulls = 0;
       
    53 my $berror = 0;
       
    54 
       
    55 while (<$in>)
       
    56 	{
       
    57 	if (/BTRACE BUFFER IS FULL/)
       
    58 		{
       
    59 			$berror = 1;
       
    60 			next;
       
    61 		}
       
    62 	if (/^RUNTESTS: Test/)
       
    63 		{
       
    64 			$testnames->{$lockinfo} = $_ if $lockinfo;
       
    65 			$berror = 0;
       
    66 			next;
       
    67 		}
       
    68 	if (/^<FM/ && /System lock/i)
       
    69 		{
       
    70 		push(@wanted, $_);
       
    71 		$lockinfo = $_;
       
    72 		$bufferfulls++ if $berror;
       
    73 		}
       
    74 	}
       
    75 
       
    76 close($in);
       
    77 
       
    78 @wanted = sort @wanted;
       
    79 
       
    80 if (ref($symbols))
       
    81 	{
       
    82 	$howmany ||= 1;
       
    83 	$howmany = 1 if $howmany < 1;
       
    84 	$howmany = scalar(@wanted) if $howmany > scalar(@wanted);
       
    85 
       
    86 	print @wanted[0 .. $#wanted - $howmany];
       
    87 
       
    88 	for my $line (@wanted[$#wanted - $howmany + 1 .. $#wanted])
       
    89 		{
       
    90 		print "\n", $line;
       
    91 
       
    92 #             MaxTime  AveTime HeldCount MaxPC    MaxTimestamp  TraceId Name
       
    93 # <FM000000>       71        7    104631 f8023ddc    300257957 640005a4 'Sys
       
    94 #
       
    95 		my @fields = split(" ", $line);
       
    96 		my $maxpc = $fields[4];
       
    97 
       
    98 		print "                                       ",
       
    99 		    $symbols->lookup($maxpc);
       
   100 
       
   101 		print "                                       ",
       
   102 		    $testnames->{$line} if $testnames->{$line};
       
   103 		}
       
   104 	}
       
   105 else
       
   106 	{
       
   107 	print @wanted;
       
   108 	}
       
   109 
       
   110 printf(STDERR "%d buffer %s found\n", $bufferfulls,
       
   111     $bufferfulls == 1 ? "overflow was" : "overflows were") if $bufferfulls;
       
   112 
       
   113 
       
   114 # ========================================================================
       
   115 #
       
   116 package SymbolTable;
       
   117 
       
   118 sub new
       
   119 {
       
   120 	my ($proto, $filename) = @_;
       
   121 
       
   122 	return undef if ! $filename;
       
   123 
       
   124 	my @symbols;
       
   125 
       
   126 	open(my $in, "<", $filename) || die("$0: $filename: $!\n");
       
   127 
       
   128 	print STDERR "Loading symbols...";
       
   129 
       
   130 	while (<$in>)
       
   131 		{
       
   132 		# f800c040    0000    btrace_fiq   k_entry_.o(.emb_text)
       
   133 		if (/^[0-9a-f]{8}\s/i)	# Have a symbol table entry
       
   134 			{
       
   135 			# Ensure the address is in lowercase
       
   136 			$_ = lc(substr($_, 0, 8)) . substr($_, 8);
       
   137 			push(@symbols, $_);
       
   138 			}
       
   139 		}
       
   140 
       
   141 	close($in);
       
   142 
       
   143 	my $symbols = [sort @symbols];
       
   144 
       
   145 	my $class = ref($proto) || $proto;
       
   146 
       
   147 	bless($symbols, $class);
       
   148 
       
   149 	print STDERR " done\n";
       
   150 
       
   151 	return $symbols;
       
   152 }
       
   153 
       
   154 # lookup() is an implementation of the binary search algorithm below,
       
   155 # retrieved from wikipedia on 10/9/07
       
   156 #
       
   157 #  BinarySearch(A[0..N-1], value) {
       
   158 #       low = 0
       
   159 #       high = N - 1
       
   160 #       while (low <= high) {
       
   161 #           mid = (low + high) / 2
       
   162 #           if (A[mid] > value)
       
   163 #               high = mid - 1
       
   164 #           else if (A[mid] < value)
       
   165 #               low = mid + 1
       
   166 #           else
       
   167 #               return mid
       
   168 #       }
       
   169 #       return not_found
       
   170 #   }
       
   171 #
       
   172 sub lookup
       
   173 {
       
   174 	my ($symbols, $addr) = @_;
       
   175 
       
   176 	return "BAD ADDRESS $addr\n" unless $addr =~ /^[0-9a-f]{8}$/i;
       
   177 	$addr = lc($addr);
       
   178 
       
   179 	my ($low, $high) = (0, $#$symbols);
       
   180 
       
   181 	while ($low <= $high)
       
   182 		{
       
   183 		my $mid = int(($low + $high) / 2);
       
   184 		my $mid_value = substr($symbols->[$mid], 0, 8);
       
   185 ## print "low: $low, high: $high, mid: $mid, mid_value: $mid_value\n";
       
   186 		if ($mid_value gt $addr)
       
   187 			{
       
   188 			$high = $mid - 1;
       
   189 			}
       
   190 		elsif ($mid_value lt $addr)
       
   191 			{
       
   192 			$low = $mid + 1;
       
   193 			}
       
   194 		else
       
   195 			{
       
   196 			# Found an exact match
       
   197 			return($symbols->[$mid]);
       
   198 			}
       
   199 		}
       
   200 
       
   201 	# We didn't find an exact match.  We want the largest value that is
       
   202 	# less than the input address.  This will be the value at either
       
   203 	# $low or $high.
       
   204 
       
   205 	return $symbols->[$low] if $low <= $#$symbols &&
       
   206 	    $symbols->[$low] lt $addr;
       
   207 	return "NO SYMBOL FOUND\n" if $high < 0;
       
   208 	return $symbols->[$high] if $symbols->[$high] lt $addr;
       
   209 	return "THIS SHOULDN'T HAPPEN\n";
       
   210 }