kerneltest/e32utils/trace/btrace_syslock.pl
author hgs
Thu, 29 Apr 2010 11:08:53 +0100
changeset 129 a990138eda40
parent 0 a41df078684a
permissions -rw-r--r--
201017_04

# Copyright (c) 2007-2009 Nokia Corporation and/or its subsidiary(-ies).
# All rights reserved.
# This component and the accompanying materials are made available
# under the terms of the License "Eclipse Public License v1.0"
# which accompanies this distribution, and is available
# at the URL "http://www.eclipse.org/legal/epl-v10.html".
#
# Initial Contributors:
# Nokia Corporation - initial contribution.
#
# Contributors:
#
# Description:
# e32utils\trace\btrace_syslock.pl
# Process runtests btrace log file to determine the maximum time the system
# lock was held for.
# Example commands to generate a runtests btrace log file with system lock 
# tracing analysis when running e32test.auto.bat and 10MB btrace buffer:
# 1 - btrace -f4,17 -m1 -b10480
# 2 - runtests e32test.auto.bat -a OR use 
# btrace -a
# after running what ever is being tested
# Syntax:
# perl btrace_syslock.pl <inputfile> [<symbolfile> [<maxsymbols]]
# If <maxsymbols> is given, this is how many of the last (i.e. slowest)
# results to look up in the symbol file.  Defaults to 1.
# 
#

use strict;

# Unbuffer stderr
my $oldfh = select(STDERR); $| = 1; select($oldfh);

print STDERR "\nTHIS TOOL IS UNOFFICIAL, UNSUPPORTED AND SUBJECT TO CHANGE WITHOUT NOTICE!\n\n";


my $usage = "$0: usage: perl $0 <logfile> [<symbolfile> [<maxsymbols>]]\n";

my ($infile, $symbolfile, $howmany) = @ARGV;

die($usage) if !($infile && -f $infile) || ($symbolfile && ! -f $symbolfile);

my $symbols = new SymbolTable($symbolfile);

open(my $in, "<", $infile) || die("$0: $infile: $!\n");

my @wanted = ();

my $lockinfo;
my $testnames = {};
my $bufferfulls = 0;
my $berror = 0;

while (<$in>)
	{
	if (/BTRACE BUFFER IS FULL/)
		{
			$berror = 1;
			next;
		}
	if (/^RUNTESTS: Test/)
		{
			$testnames->{$lockinfo} = $_ if $lockinfo;
			$berror = 0;
			next;
		}
	if (/^<FM/ && /System lock/i)
		{
		push(@wanted, $_);
		$lockinfo = $_;
		$bufferfulls++ if $berror;
		}
	}

close($in);

@wanted = sort @wanted;

if (ref($symbols))
	{
	$howmany ||= 1;
	$howmany = 1 if $howmany < 1;
	$howmany = scalar(@wanted) if $howmany > scalar(@wanted);

	print @wanted[0 .. $#wanted - $howmany];

	for my $line (@wanted[$#wanted - $howmany + 1 .. $#wanted])
		{
		print "\n", $line;

#             MaxTime  AveTime HeldCount MaxPC    MaxTimestamp  TraceId Name
# <FM000000>       71        7    104631 f8023ddc    300257957 640005a4 'Sys
#
		my @fields = split(" ", $line);
		my $maxpc = $fields[4];

		print "                                       ",
		    $symbols->lookup($maxpc);

		print "                                       ",
		    $testnames->{$line} if $testnames->{$line};
		}
	}
else
	{
	print @wanted;
	}

printf(STDERR "%d buffer %s found\n", $bufferfulls,
    $bufferfulls == 1 ? "overflow was" : "overflows were") if $bufferfulls;


# ========================================================================
#
package SymbolTable;

sub new
{
	my ($proto, $filename) = @_;

	return undef if ! $filename;

	my @symbols;

	open(my $in, "<", $filename) || die("$0: $filename: $!\n");

	print STDERR "Loading symbols...";

	while (<$in>)
		{
		# f800c040    0000    btrace_fiq   k_entry_.o(.emb_text)
		if (/^[0-9a-f]{8}\s/i)	# Have a symbol table entry
			{
			# Ensure the address is in lowercase
			$_ = lc(substr($_, 0, 8)) . substr($_, 8);
			push(@symbols, $_);
			}
		}

	close($in);

	my $symbols = [sort @symbols];

	my $class = ref($proto) || $proto;

	bless($symbols, $class);

	print STDERR " done\n";

	return $symbols;
}

# lookup() is an implementation of the binary search algorithm below,
# retrieved from wikipedia on 10/9/07
#
#  BinarySearch(A[0..N-1], value) {
#       low = 0
#       high = N - 1
#       while (low <= high) {
#           mid = (low + high) / 2
#           if (A[mid] > value)
#               high = mid - 1
#           else if (A[mid] < value)
#               low = mid + 1
#           else
#               return mid
#       }
#       return not_found
#   }
#
sub lookup
{
	my ($symbols, $addr) = @_;

	return "BAD ADDRESS $addr\n" unless $addr =~ /^[0-9a-f]{8}$/i;
	$addr = lc($addr);

	my ($low, $high) = (0, $#$symbols);

	while ($low <= $high)
		{
		my $mid = int(($low + $high) / 2);
		my $mid_value = substr($symbols->[$mid], 0, 8);
## print "low: $low, high: $high, mid: $mid, mid_value: $mid_value\n";
		if ($mid_value gt $addr)
			{
			$high = $mid - 1;
			}
		elsif ($mid_value lt $addr)
			{
			$low = $mid + 1;
			}
		else
			{
			# Found an exact match
			return($symbols->[$mid]);
			}
		}

	# We didn't find an exact match.  We want the largest value that is
	# less than the input address.  This will be the value at either
	# $low or $high.

	return $symbols->[$low] if $low <= $#$symbols &&
	    $symbols->[$low] lt $addr;
	return "NO SYMBOL FOUND\n" if $high < 0;
	return $symbols->[$high] if $symbols->[$high] lt $addr;
	return "THIS SHOULDN'T HAPPEN\n";
}