#!/usr/athena/bin/perl
# $Header: //rlischner/local_user/lisch/src/perlprof/RCS/pprof.perl,v 1.1 1991/07/19 16:25:46 lisch Exp $
#
# Print the raw profiling data generated by perl -d.
#
# The data are usually written to the file "perlmon.out".
# The user can control the format of the out output in some limited ways.
#
# CPU time, elapsed time, and execution counts are tallied in
# the profiling information.
#
# There are two sections: the subroutine section and the line section.
# The former lists the subroutines, sorted by total CPU time, total
# elapsed time, number of calls, CPU time per call, elapsed time
# per call, by name, or unsorted (hash table order).
#
# The second section shows the breakdown per source line.  The user
# can elect to see the information presented next to each source line,
# or without the actual line, or with unexecuted lines removed or present.
# I thought about how to sort the lines of each file in order of CPU
# or elapsed time, but could not come up with a meaningful presentation.
# It is very easy to print a jumble that is difficult to interpret.
#
# The format of the input file is as follows:
# file ::= cpu "\n" elapsed "\n" subroutines line_info
# cpu ::= number
# elapsed ::= number
# subroutines ::= /*empty*/ | subroutines subroutine
# subroutine ::= "S" string " " cpu " " elapsed " " count "\n"
# count ::= number
# line_info ::= /*empty*/ | line_info file | line_info line
# file ::= "F" file_number " " string "\n"
# line ::= line_number " " file_number " " count " " cpu " " elapsed "\n"
# file_number ::= number
# line_number ::= number
#
# The numbers are floating point.  A file_number is defined before
# it is used.
#
# $Log: pprof.perl,v $
# Revision 1.1  1991/07/19  16:25:46  lisch
# Initial revision
#

sub version
{
    ($v, $g) = ('$Header: //rlischner/local_user/lisch/src/perlprof/RCS/pprof.perl,v 1.1 1991/07/19 16:25:46 lisch Exp $' =~ m@,v ([\d.]+) ([\d/]+) @);
    print "$0, revision $v, $g\n";
}

sub usage
{
    print "usage: $0 [-cCflnosStTux] [-help] [-usage] [-version] [files...]\n";
}

sub help
{
    &usage;
    ($program) = ($0 =~ m@([^/]+$)@);
    print <<EOF;
Print profiling measurements obtained by running perl with the -m option.
By default, these statistics are recorded in the file perlmon.out.

The statistics are printed in a neat format by $program, according to
user directives specified on the command line:

-c	sort subroutines by total cpu time (default)
-C	sort subroutines by cpu time per call
-t	sort subroutines by total elapsed time
-T	sort subroutines by elapsed time per call
-n	sort subroutines by number of calls
-s	sort subroutines by name
-u	subroutine listing is unsorted

-S	do not print subroutine statistics

-l	do not include per-source line statistics
-f	do not read source files to print actual source lines
-x	do not print unexecuted lines

-o	do not print overall statistics
EOF
}

$total_cpu = 0;		# total CPU time in sec
$total_time = 0;	# total elapsed time in sec

# Load the data from a file, accumulating it with existing data, if any.
# The @filenum array provides a local mapping from file numbers in the file
# to file numbers used in this script.
#
# Typically, the user merges files that are produced from the same script,
# so the same filenames and local numbers are used.  We cannot assume this,
# however, because PATH changes, etc., might change file path names
# unexpectedly.  Instead, we keep track of all the file names, assigning
# a unique number to each.  Within one profile data file, we keep a local
# mapping of file numbers to global numbers.  Hmmm, this description
# is probably less clear than the code...

$nfiles = $[;
$exit = 0;
sub load
{
    local($filename) = @_;

    if (! open(IN, $filename)) {
	print STDERR "$0: cannot load data from $file: $!\n";
	$exit = 1;
    } else {
	$total_cpu += <IN>;
	$total_time += <IN>;

	undef @filenum;
	while (<IN>)
	{
	    if (/^S/) {
		last if ! $print_subs && ! $print_lines;
		next if ! $print_subs;

		# subroutine data
		($junk, $sub, $cpu, $time, $count) = split(/ /, $_, 5);
		$sub_count{$sub} += $count;
		$sub_cpu{$sub} += $cpu;
		$sub_time{$sub} += $time;
	    } elsif (/^F/) {
		last if ! $print_lines;

		# local file number<->name mapping
		chop;
		($junk, $num, $filename) = split(/ /, $_, 3);
		if (defined $filenames{$filename}) {
		    $n = $filenames{$filename};
		} else {
		    $n = $filenames{$filename} = $nfiles++;
		}
		$filenum[$num] = $n;
	    } else {
		# data for one source line
		($line, $n, $count, $cpu, $time) = split(/ /, $_, 5);
		$n = $filenum[$n];
		eval <<EOF || die "$0: $@";
		    \$count$n\[$line] += $count;
		    \$cpu$n\[$line] += $cpu;
		    \$time$n\[$line] += $time;
		    1
EOF
	    }
	}
	close(IN);
    }
}

# how to sort:
$sort = 'by_cpu';		# default is by CPU time
sub by_name
{
    $a cmp $b;
}

sub by_cpu
{
    $sub_cpu{$b} <=> $sub_cpu{$a};
}

sub by_cpu_per_call
{
    $sub_cpu{$b}/$sub_count{$b} <=> $sub_cpu{$a}/$sub_count{$b};
}

sub by_time
{
    $sub_time{$b} <=> $sub_time{$a};
}

sub by_time_per_call
{
    $sub_time{$b}/$sub_count{$b} <=> $sub_time{$a}/$sub_count{$b};
}

sub by_count
{
    $sub_count{$b} <=> $sub_count{$a};
}

# sort the subroutines
sub sort_sub
{
    if ($sort eq '') {
	keys %sub_count;
    } else {
	sort $sort keys %sub_count;
    }
}

$print_subs = 1;		# print info about subroutines?
$print_totals = 1;		# print overall totals?
$print_lines = 1;		# print per-line info?
$print_source = 1;		# print source lines, too?
$print_unexec = 1;		# print unexecuted lines?

# print the data for one line
sub print_line
{
    local(*count, *cpu, *time) = @_;
    for ($i = 1; $i <= $#count; ++$i)
    {
	if (! $source) {
	    $line = "line $i\n";
	} elsif ($print_unexec) {
	    $line = <IN>;
	} else {
	    $line = sprintf("%6d %s", $i, scalar(<IN>));
	}

	if ($count[$i]) {
	    printf "%7d %7d %8.3f\t%s", $count[$i], $time[$i], $cpu[$i], $line;
	} elsif ($print_unexec) {
	    print " " x 24, "\t", $line;
	}
    }
}

# print the accumulated data
sub print
{
    $ff = '';
    if ($print_totals) {
	printf "total cpu time = %.3f sec\n", $total_cpu;
	printf "total elapsed time = %d sec\n", $total_time;
	$ff = "\n";
    }

    # first print the subroutine statistics
    if ($print_subs && $total_cpu != 0 && $total_time != 0) {
	print "$ff %cpu %time   calls  cpu-sec  elapsed cpu/call sec/call\tsubroutine\n";
	foreach $s (&sort_sub)
	{
	    ($cpu, $time, $count)=($sub_cpu{$s}, $sub_time{$s}, $sub_count{$s});
	    printf("%5.1f %5.1f %7d %8.3f %8d %8.3f %8d\t%s\n",
		   $cpu*100/$total_cpu, $time*100/$total_time,
		   $count, $cpu, $time,
		   $cpu/$count, $time/$count, $s);
	}
	$ff = "\f";
    }

    # next print the file statistics
    if ($print_lines) {
	while (($filename, $n) = each(%filenames)) {
	    local($source) = $print_source;
	    if ($source && ! open(IN, $filename))
	    {
		print STDERR "$0: cannot read source file, $filename: $!\n",
		$source = 0;
	    }

	    print "$ff  count     sec  cpu-sec\t";
	    if (! $print_unexec && $source) {
		print "lineno ";
	    }
	    print $filename, ":\n";

	    eval "&print_line(*count$n, *cpu$n, *time$n); 1" || die "$0: $@";
	    close(IN) if $source;
	    $ff = "\f";
	}
    }
}

while ($arg = shift(@ARGV))
{
    ($opt, $rest) = ($arg =~ /^-(.)(.*)/);
    if ($opt eq '') {
	$any = 1;
	&load($arg);
    } elsif ($arg eq '-help') {
	&help;
	exit;
    } elsif ($arg eq '-usage') {
	&usage;
	exit;
    } elsif ($opt eq 'v') {
	&version;
	exit;
    } elsif ($opt eq 's') {
	$sort = 'by_name';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'u') {
	$sort = '';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'S') {
	$print_subs = ! $print_subs;
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 't') {
	$sort = 'by_time';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'T') {
	$sort = 'by_time_per_call';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'c') {
	$sort = 'by_cpu';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'C') {
	$sort = 'by_cpu_per_call';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'n') {
	$sort = 'by_count';
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'l') {
	$print_lines = ! $print_lines;
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'f') {
	$print_source = ! $print_source;
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'o') {
	$print_totals = ! $print_totals;
	unshift(@ARGV, "-$rest") if $rest ne '';
    } elsif ($opt eq 'x') {
	$print_unexec = ! $print_unexec;
	unshift(@ARGV, "-$rest") if $rest ne '';
    } else {
	select(STDERR);
	print "$0: unknown option: $arg\n";
	&usage;
	exit(1);
    }
}

# if the user does not specify any files, then load the default
if (! $any) {
    &load($ENV{"PERLMON"} || "perlmon.out");
}

&print;
exit($exit);