274 lines
		
	
	
		
			7.1 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			274 lines
		
	
	
		
			7.1 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/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";
 | 
						|
}
 | 
						|
 |