# 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";

}