mirror of
https://github.com/SWG-Source/swg-main.git
synced 2026-01-16 20:04:18 -05:00
128 lines
3.1 KiB
Perl
Executable File
128 lines
3.1 KiB
Perl
Executable File
# Script to take output from the Transform::multiply tracking REPORT_LOG output
|
|
# and generate a report of callstacks sorted in descending frequency order.
|
|
|
|
use strict;
|
|
|
|
my $inCallstack = 0;
|
|
my $callstackFrequency = 0;
|
|
my $callstackLinesRef;
|
|
my $debug = 0;
|
|
|
|
my %callstacksByFrequency;
|
|
|
|
sub submitCallstack
|
|
{
|
|
die "bad callstackFrequency [$callstackFrequency]" if (!($callstackFrequency =~ m/^\d+$/));
|
|
return if (@$callstackLinesRef < 1);
|
|
|
|
# Make sure there's an array reference to hold all callstacks mapping to this frequency.
|
|
if (!exists $callstacksByFrequency{$callstackFrequency})
|
|
{
|
|
$callstacksByFrequency{$callstackFrequency} = [];
|
|
}
|
|
|
|
# Get array ref.
|
|
my $callstackArrayRef = $callstacksByFrequency{$callstackFrequency};
|
|
|
|
# Add callstack lines array to it.
|
|
push @$callstackArrayRef, $callstackLinesRef;
|
|
}
|
|
|
|
sub resetCallstack
|
|
{
|
|
$callstackLinesRef = [];
|
|
}
|
|
|
|
while (<>)
|
|
{
|
|
#-- Clean up line: remove line number and time info from log.
|
|
chomp();
|
|
s/\d+\s+\d+\.\d+\s+//;
|
|
|
|
#-- Process line.
|
|
|
|
# Check if this matches a start of callstack line.
|
|
if (m/Transform::multiply/)
|
|
{
|
|
if ($inCallstack)
|
|
{
|
|
# Add existing (now complete) callstack, restart a new one immediately following, starting on this line.
|
|
submitCallstack();
|
|
}
|
|
else
|
|
{
|
|
# Mark that we're now in a callstack so we know to scan following lines.
|
|
$inCallstack = 1;
|
|
}
|
|
resetCallstack();
|
|
|
|
# Parse out frequency.
|
|
if (m/called (\d+) times/)
|
|
{
|
|
$callstackFrequency = $1;
|
|
}
|
|
else
|
|
{
|
|
die "Failed to get call frequency on input line [$_]";
|
|
}
|
|
|
|
# Remove unique callstack numeric info at end since we sort differently (by frequency) than raw output.
|
|
s/\s\(\d+ of \d+ unique callstacks\)//;
|
|
|
|
# Add header line to callstack lines.
|
|
push @$callstackLinesRef, $_;
|
|
|
|
print "Found callstack frequency [$callstackFrequency]\n" if $debug;
|
|
}
|
|
elsif ($inCallstack)
|
|
{
|
|
# Fixiup lines I bumbled output on.
|
|
s/(\d+) caller \d+/caller $1/;
|
|
|
|
if (m/caller \d+/)
|
|
{
|
|
if (!m/unknown/)
|
|
{
|
|
# Looks like a good callstack line, keep it.
|
|
push @$callstackLinesRef, $_;
|
|
}
|
|
}
|
|
else
|
|
{
|
|
# Looks like this callstack is done.
|
|
submitCallstack();
|
|
$inCallstack = 0;
|
|
}
|
|
}
|
|
}
|
|
|
|
# Print out callstacks sorted by descending numeric frequency.
|
|
my @frequencies = sort { return $b <=> $a; } (keys %callstacksByFrequency);
|
|
|
|
print "There are ", @frequencies + 0, " unique callstack frequencies.\n";
|
|
foreach my $frequency (@frequencies)
|
|
{
|
|
my $callstackArrayRef = $callstacksByFrequency{$frequency};
|
|
my $callstackCount = @$callstackArrayRef;
|
|
|
|
print "========================================\n";
|
|
print "FREQUENCY: $frequency ($callstackCount callstacks)\n";
|
|
print "========================================\n";
|
|
print "\n";
|
|
for (my $i = 0; $i < $callstackCount; ++$i)
|
|
{
|
|
my $callstackLinesRef = $$callstackArrayRef[$i];
|
|
my $lineCount = @$callstackLinesRef;
|
|
|
|
print "$$callstackLinesRef[0]\n";
|
|
for (my $lineIndex = 1; $lineIndex < $lineCount; ++$lineIndex)
|
|
{
|
|
print "\t$$callstackLinesRef[$lineIndex]\n";
|
|
}
|
|
print "\n";
|
|
}
|
|
}
|
|
|
|
print "DONE.\n";
|
|
|