use strict;
use Getopt::Long;
my %collapsed;
sub remember_stack {
my ($stack, $count) = @_;
$collapsed{$stack} += $count;
}
my $annotate_kernel = 0; my $include_pname = 1; my $include_pid = 0; my $include_tid = 0; my $tidy_java = 1; my $tidy_generic = 1; my $target_pname;
my $show_inline = 0;
my $show_context = 0;
GetOptions('inline' => \$show_inline,
'context' => \$show_context,
'pid' => \$include_pid,
'kernel' => \$annotate_kernel,
'tid' => \$include_tid)
or die <<USAGE_END;
USAGE: $0 [options] infile > outfile\n
--pid # include PID with process names [1]
--tid # include TID and PID with process names [1]
--inline # un-inline using addr2line
--kernel # annotate kernel functions with a _[k]
--context # adds source context to --inline\n
[1] perf script must emit both PID and TIDs for these to work; eg:
perf script -f comm,pid,tid,cpu,time,event,ip,sym,dso,trace
USAGE_END
sub inline {
my ($pc, $mod) = @_;
my $a2l_output = `addr2line -a $pc -e $mod -i -f -s -C`;
$a2l_output =~ s/^(.*\n){1}//;
my @fullfunc;
my $one_item = "";
for (split /^/, $a2l_output) {
chomp $_;
$_ =~ s/ \(discriminator \S+\)//;
if ($one_item eq "") {
$one_item = $_;
} else {
if ($show_context == 1) {
unshift @fullfunc, $one_item . ":$_";
} else {
unshift @fullfunc, $one_item;
}
$one_item = "";
}
}
return join(";", @fullfunc);
}
my @stack;
my $pname;
my $m_pid;
my $m_tid;
while (defined($_ = <>)) {
if (/^# cmdline/) {
my @args = split ' ', $_;
foreach my $arg (reverse @args) {
if ($arg !~ /^-/) {
$target_pname = $arg;
$target_pname =~ s:.*/::; last;
}
}
}
next if m/^#/;
chomp;
if (m/^$/) {
if ($include_pname) {
if (defined $pname) {
unshift @stack, $pname;
} else {
unshift @stack, "";
}
}
remember_stack(join(";", @stack), 1) if @stack;
undef @stack;
undef $pname;
next;
}
if (/^(\S.+?)\s+(\d+)\/*(\d+)*\s+/) {
if ($3) {
($m_pid, $m_tid) = ($2, $3);
} else {
($m_pid, $m_tid) = ("?", $2);
}
if ($include_tid) {
$pname = "$1-$m_pid/$m_tid";
} elsif ($include_pid) {
$pname = "$1-$m_pid";
} else {
$pname = $1;
}
$pname =~ tr/ /_/;
} elsif (/^\s*(\w+)\s*(.+) \((\S*)\)/) {
my ($pc, $rawfunc, $mod) = ($1, $2, $3);
$rawfunc.="_[k]" if ($annotate_kernel == 1 && $mod =~ m/(kernel\.|vmlinux$)/);
if ($show_inline == 1 && $mod !~ m/(perf-\d+.map|kernel\.|\[[^\]]+\])/) {
unshift @stack, inline($pc, $mod);
next;
}
next if $rawfunc =~ /^\(/;
my @inline;
for (split /\->/, $rawfunc) {
my $func = $_;
if ($func eq "[unknown]" && $mod ne "[unknown]") { $func = $mod;
$func =~ s/.*\///;
$func = "\[$func\]";
}
if ($tidy_generic) {
$func =~ s/;/:/g;
if ($func !~ m/\.\(.*\)\./) {
$func =~ s/\((?!anonymous namespace\)).*//;
}
$func =~ tr/"\'//d;
}
if ($tidy_java and $pname eq "java") {
$func =~ s/^L// if $func =~ m:/:;
}
$func .= "_[i]" if scalar(@inline) > 0; push @inline, $func;
}
unshift @stack, @inline;
} else {
warn "Unrecognized line: $_";
}
}
foreach my $k (sort { $a cmp $b } keys %collapsed) {
print "$k $collapsed{$k}\n";
}