minix/commands/profile/cprofalyze.pl

274 lines
7.1 KiB
Perl
Raw Normal View History

2010-09-23 15:49:52 +02:00
#!/usr/pkg/bin/perl
#
# cprofalyze.pl
#
# Analyzes the output files created by the profile command for
# Call Profiling.
#
# Changes:
# 14 Aug, 2006 Created (Rogier Meurs)
#
$UNSIGNED_MAX_DIV_K = 2**32/1000;
if ($#ARGV == 0 || process_args(@ARGV)) {
print "Usage:\n";
print " cprofalyze.pl <clock> [-f] [-aoct] [-i] [-n number] file ...\n\n";
print " clock CPU clock of source machine in MHz (mandatory)\n";
print " -f print totals per function (original order lost)\n";
print " -a sort alphabetically (default)\n";
print " -o no sort (original order)\n";
print " -c sort by number of calls\n";
print " -t sort by time spent\n";
print " -n print maximum of number lines per process\n";
print " -i when -[ao] used: print full paths\n";
exit 1;
}
sub process_args {
$_ = shift;
return 1 unless /^(\d+)$/;
return 1 if $1 == 0;
$MHz = $1;
$sort_method = "A";
while (@_[0] =~ /^-/) {
$_ = shift;
SWITCH: {
if (/^-a$/) { $sort_method = "A"; last SWITCH; }
if (/^-o$/) { $sort_method = "O"; last SWITCH; }
if (/^-c$/) { $sort_method = "C"; last SWITCH; }
if (/^-t$/) { $sort_method = "T"; last SWITCH; }
if (/^-i$/) { $print_full_paths = 1; last SWITCH; }
if (/^-f$/) { $print_totals = 1; last SWITCH; }
if (/^-n$/) {
$_ = shift;
return 1 unless /^(\d+)$/;
return 1 unless $1 > 0;
$show_paths = $1;
last SWITCH;
}
return 1;
}
}
$print_full_paths == 1 && ($sort_method eq "T" || $sort_method eq "C") &&
{ $print_full_paths = 0 };
@files = @_;
return 0;
}
print <<EOF;
Notes:
- Calls attributed to a path are calls done on that call level.
For instance: a() is called once and calls b() twice. Call path "a" is
attributed 1 call, call path "a b" is attributed 2 calls.
- Time spent blocking is included.
- Time attributed to a path is time spent on that call level.
For instance: a() spends 10 cycles in its own body and calls b() which
spends 5 cycles in its body. Call path "a" is attributed 10 cycles,
call path "a b" is attributed 5 cycles.
- Time is attributed when a function exits. Functions calls that have not
returned yet are therefore not measured. This is most notable in main
functions that are printed as having zero cycles.
- When "profile reset" was run, the actual resetting in a process happens
when a function is entered. In some processes (for example, blocking
ones) this may not happen immediately, or at all.
EOF
print "Clockspeed entered: $MHz MHz. ";
SWITCH: {
if ($sort_method eq "A")
{ print "Sorting alphabetically. "; last SWITCH; }
if ($sort_method eq "C")
{ print "Sorting by calls. "; last SWITCH; }
if ($sort_method eq "T")
{ print "Sorting by time spent. "; last SWITCH; }
print "No sorting applied. ";
}
print "\n";
$print_totals and print "Printing totals per function. ";
$show_paths == 0 ? print "Printing all call paths.\n" :
print "Printing max. $show_paths lines per process.\n";
foreach $file (@files) {
$file_res = read_file($file);
next if $file_res == 0;
print_file($print_totals ? make_totals($file_res) : $file_res);
}
exit 0;
sub read_file
{
$file = shift;
my %file_res = ();
my @exe;
my $exe_name, $slots_used, $buf, $lo, $hi, $cycles_div_k, $ms;
unless (open(FILE, $file)) {
print "\nERROR: Unable to open $file: $!\n";
return 0;
}
$file =~ s/^.*\///; # basename
# First line: check file type.
$_ = <FILE>; chomp;
if (!/^call$/) {
if (/^stat$/) {
print "Statistical Profiling output file: ";
print "Use sprofalyze.pl instead.\n";
} else {
print "Not a profiling output file.\n";
}
return 0;
}
# Second line: header with call path string size.
$_ = <FILE>; chomp;
($CPATH_MAX_LEN, $PROCNAME_LEN) = split(/ /);
$SLOT_SIZE = $CPATH_MAX_LEN + 16;
$EXE_HEADER_SIZE = $PROCNAME_LEN + 4;
# Read in the data for all the processes and put it in a hash of lists.
# A list for each process, which contains lists itself for each call
# path.
until(eof(FILE)) {
read(FILE, $buf, $EXE_HEADER_SIZE) == $EXE_HEADER_SIZE or
die ("Short read.");
($exe_name, $slots_used) = unpack("Z${PROCNAME_LEN}i", $buf);
@exe = ();
for ($i=0; $i<$slots_used; $i++) {
read(FILE, $buf, $SLOT_SIZE) == $SLOT_SIZE or
die ("Short read.");
($chain, $cpath, $calls, $lo, $hi) =
unpack("iA${CPATH_MAX_LEN}iII", $buf);
$cycles_div_k = $hi * $UNSIGNED_MAX_DIV_K;
$cycles_div_k += $lo / 1000;
$ms = $cycles_div_k / $MHz;
push @exe, [ ($cpath, $calls, $ms) ];
}
$file_res{$exe_name} = [ @exe ];
}
return \%file_res;
}
# Aggregate calls and cycles of paths into totals for each function.
sub make_totals
{
my $ref = shift;
my %file_res = %{$ref};
my $exe;
my %res, %calls, %time;
my @totals;
foreach $exe (sort keys %file_res) {
@totals = ();
%calls = ();
%time = ();
@ar = @{$file_res{$exe}};
foreach $path (@ar) {
$_ = $path->[0];
s/^.* //; # basename of call path
$calls{$_} += $path->[1];
$time{$_} += $path->[2];
}
foreach $func (keys %calls) {
push @totals, [ ($func, $calls{$func}, $time{$func}) ];
}
$res{$exe} = [ @totals ];
}
return \%res;
}
sub print_file
{
my $ref = shift;
my %file_res = %{$ref};
my $exe;
printf "\n========================================";
printf "========================================\n";
printf("Data file: %s\n", $file);
printf "========================================";
printf "========================================\n\n";
# If we have the kernel, print it first. Then the others.
print_exe($file_res{"kernel"}, "kernel") if exists($file_res{"kernel"});
foreach $exe (sort keys %file_res) {
print_exe($file_res{$exe}, $exe) unless $exe eq "kernel";
}
}
sub print_exe
{
my $ref = shift;
my $name = shift;
my @exe = @{$ref};
my @funcs, @oldfuncs;
my $slots_used = @exe;
# Print a header.
printf "----------------------------------------";
printf "----------------------------------------\n";
$print_totals ? printf "%-8s %60s functions\n", $name, $slots_used :
printf "%-8s %59s call paths\n", $name, $slots_used;
printf "----------------------------------------";
printf "----------------------------------------\n";
printf("%10s %12s path\n", "calls", "msecs");
printf "----------------------------------------";
printf "----------------------------------------\n";
SWITCH: {
if ($sort_method eq "A") {
@exe = sort { lc($a->[0]) cmp lc($b->[0]) } @exe; last SWITCH; }
if ($sort_method eq "C") {
@exe = reverse sort { $a->[1] <=> $b->[1] } @exe; last SWITCH; }
if ($sort_method eq "T") {
@exe = reverse sort { $a->[2] <=> $b->[2] } @exe; last SWITCH; }
last SWITCH;
}
my $paths;
@oldfuncs = ();
foreach $path (@exe) {
printf("%10u %12.2f ", $path->[1], $path->[2]);
if ($print_full_paths == 1 ||
($sort_method eq "C" || $sort_method eq "T")) {
print $path->[0];
} else {
@funcs = split(/ /, $path->[0]);
for (my $j=0; $j<=$#funcs; $j++) {
if ($j<=$#oldfuncs && $funcs[$j] eq $oldfuncs[$j]) {
print " ---";
} else {
print " " if ($j > 0);
print $funcs[$j];
}
}
@oldfuncs = @funcs;
}
print "\n";
last if (++$paths == $show_paths);
}
print "\n";
}