#!/usr/local/bin/perl

use strict;

###
# profile.pl
#
# Perl program to process profiling output and convert it to
# gprof-compatible output.
#
# Copyright, Laszlo Systems, Inc. 2003
# All rights reserved.
#
# This software is the proprietary information of Laszlo Systems, Inc.
# Use is subject to license terms.
###

my %events;

# Suck all the events into a table
while (<>)
{
    # eat record separator (geez, shouldn't it always?)
    chomp;
    if (/^\s*([0-9.]+)\s+([CRSEV])\s*(.*)$/) {
      if ($events{$1}{$2}) {
        print "\nClobbering ", $1,$2,$events{$1}{$2}, " with ", $3;
      }
      $events{$1}{$2} = $3; 
    } elsif (/^\s*$/) {
        # Skip blank lines
    }
    else {
        # Echo non-events (e.g., annotation)
        print "\n", $_;
    }
}

my $dump_start = 0;
my $dump_end = 0;
my $dump_elapsed = 0;
my $start_time = -1;
my $end_time = -1;
my $idle_time = 0;

# Calculate total time for program
# Total should be the last time - first time, with dump times elided
# We calculate it as the sum of all the top level calls
my $total = 0;

my %calls;
my %selfcalls;
my %supcalls;
my %subcalls;
my %rets;
my %enter;
my %cycle;
my @parent;
my %time;
my %suprets;
my %subrets;
my %subtime;
my %subenter;

sub docall {
  my ($timestamp, $fun) = @_;
  # Capture start time on the first call
  if ($start_time == -1) { $start_time = $timestamp; }
  # Count calls
  $calls{$fun} += 1;
  # Look for cycles
  if ( $enter{$fun} ) {
    push(@{$cycle{$fun}}, $enter{$fun});
    $selfcalls{$fun} += 1;
  } else {
    # Record entry time
    $enter{$fun} = $timestamp - $dump_elapsed;
    # Record call chain
    if ($#parent >= 0) {
      my $p = $parent[$#parent];
      if ( $fun eq $p ) {
      } else {
        $supcalls{$fun}{$p} += 1;
        $subcalls{$p}{$fun} += 1;
        $subenter{$p}{$fun} = $timestamp - $dump_elapsed;
      }
    } elsif ($end_time != -1) {
      # Time spent in unmetered functions
      $idle_time += $timestamp - $end_time;
    }
    # Maintain call stack
    push(@parent, $fun);
  }
}  

sub doret {
  my ($timestamp, $fun) = @_;
  # Ignore returns that come before first call (metering enabled in call)
  if ($start_time == -1) { return; }
  # Capture $end_time on last return
  $end_time = $timestamp;
  # Count returns
  $rets{$fun} += 1;
  my $ent = $enter{$fun};
  # Update cycles
  $enter{$fun} = pop(@{$cycle{$fun}});
  # Compute total time (only when not in a cycle)
  if (! $enter{$fun} ) {
    # Sanity
    if ( $parent[$#parent] ne $fun) {
      my $exp = $parent[$#parent];
      print "\nHuh? ", $fun, " (called ", $ent, ", returning ", $timestamp, ") expected ", $exp, " (called ", $enter{$exp}, ")";
    } else {
      $time{$fun} += ($timestamp - $dump_elapsed - $ent);
      # Maintain call stack
      pop(@parent);
      # Acumulate total
      if ($#parent == -1) {
        $total += ($timestamp - $dump_elapsed - $ent);
      }
      # Record return chain
      if ($#parent >= 0) {
        my $p = $parent[$#parent];
        if ( $fun eq $p ) {
        } else {
          $suprets{$fun}{$p} += 1;
          $subrets{$p}{$fun} += 1;
          $subtime{$p}{$fun} += ($timestamp - $dump_elapsed - $subenter{$p}{$fun});
        }
      }
    }
  }
}

my %log;

my $timestamp;
# Sort the events by time
foreach $timestamp (sort { $a <=> $b } (keys %events)) {
  ## Single calls come before returns.  If there are coincident events
  ## of any time, they will be logged in events and tagged with their
  ## type

  # Process call events
  if (my $entry = $events{$timestamp}{"C"}) {
    docall($timestamp, $entry);
  }
  # Process return events
  if (my $entry = $events{$timestamp}{"R"}) {
    doret($timestamp, $entry);
  }
  # Process a log event
  if (my $entry = $events{$timestamp}{"V"}) {
    # Events can be multiple
    my @entries = split(',', $entry);
    my $event = shift(@entries);
    # First event is either 'undefined' or a plain event
    if ($event ne 'undefined') {
      $log{$timestamp - $dump_elapsed} = $event;
    }
    # Now check for coincident events
    while ($#entries >= 0) {
      $event = shift(@entries);
      my ($type, $description) = split(':', $event);
      if ($type eq 'calls') {
        docall($timestamp, $description);
      } elsif ($type eq 'returns') {
        doret($timestamp, $description);
      } elsif ($type eq 'events') {
        $log{$timestamp - $dump_elapsed} = $description
      } else {
        print "\nUnknown event: ", $timestamp, " ", $type, " ", $description;
      }
    }
  }
  # Process a dump start event
  if ($events{$timestamp}{"S"}) {
    if ($dump_start) {
      printf("\nMissing dump end: %8.2f -> %8.2f", $dump_start, $timestamp);
    }
    $dump_start = $timestamp;
  }
  # Process a dump end event
  if ($events{$timestamp}{"E"}) {
    if (!$dump_start) {
      printf("\nMissing dump start: %8.2f -> %8.2f", $dump_end, $timestamp);
    }
    $dump_end = $timestamp;
    # Only accumulate dump overhead that occurred during metering
    if ($dump_start <= $end_time && $dump_end >= $start_time) {
      $dump_elapsed += (min($end_time, $dump_end) - max($start_time, $dump_start));
    }
    $dump_start = 0;
  }
}

# End any outstanding calls
while ($#parent >= 0) {
  doret($end_time, $parent[$#parent]);
}

my %index;
my %subtotal;

# Assign indices to functions
my $i = 0;
my $fun;
foreach $fun (sort {$time{$b} <=> $time{$a}} (keys %rets)) {
    $index{$fun} = $i++;
    my $bc = $subcalls{$fun};
    # Accumulate per function total time in callees
    my $st = $subtime{$fun};
    foreach my $child (keys %$bc) {
        $subtotal{$fun} += $st->{$child};
    }
    # Accumulate total program time
#    $total += ($time{$fun} - $subtotal{$fun});
}

print "\n\cL\n";

# Output summary statistics
printf("Total time: %.0fms(cpu) %.2fs(overhead) %.2fs(unmetered) %.0fms(unknown) %.2fs(elapsed)\n",
       $total, $dump_elapsed / 1000.0, $idle_time / 1000.0,
       ($end_time - $start_time - $idle_time - $dump_elapsed - $total),
       ($end_time - $start_time)  / 1000.0);

print "\n\cL\n";

# Output call graph

# [From gprof]
print "
call graph profile:
          The sum of self and descendents is the major sort
          for this listing.

          function entries:

index     the index of the function in the call graph
          listing, as an aid to locating it (see below).

%time     the percentage of the total time of the program
          accounted for by this function and its
          descendents.

self      the number of seconds spent in this function
          itself.

descendents
          the number of seconds spent in the descendents of
          this function on behalf of this function.

called    the number of times this function is called (other
          than recursive calls).

self      the number of times this function calls itself
          recursively.

name      the name of the function, with an indication of
          its membership in a cycle, if any.

index     the index of the function in the call graph
          listing, as an aid to locating it.


          parent listings:

self      the number of seconds of this function's self time
          which is due to calls from this parent.

descendents
          the number of seconds of this function's
          descendent time which is due to calls from this
          parent.

called    the number of times this function is called by
          this parent.  This is the numerator of the
          fraction which divides up the function's time to
          its parents.

total     the number of times this function was called by
          all of its parents.  This is the denominator of
          the propagation fraction.

parents   the name of this parent, with an indication of the
          parent's membership in a cycle, if any.

index     the index of this parent in the call graph
          listing, as an aid in locating it.


          children listings:

self      the number of seconds of this child's self time
          which is due to being called by this function.

descendents
          the number of seconds of this child's descendent's
          time which is due to being called by this
          function.

called    the number of times this child is called by this
          function.  This is the numerator of the
          propagation fraction for this child.

total     the number of times this child is called by all
          functions.  This is the denominator of the
          propagation fraction.

children  the name of this child, and an indication of its
          membership in a cycle, if any.

index     the index of this child in the call graph listing,
          as an aid to locating it.
";

# We don't do this

#           * these fields are omitted for parents (or
#           children) in the same cycle as the function.  If
#           the function (or child) is a member of a cycle,
#           the propagated times and propagation denominator
#           represent the self time and descendent time of the
#           cycle as a whole.
#
#           ** static-only parents and children are indicated
#           by a call count of 0.
#
#
#
#           cycle listings:
#           the cycle as a whole is listed with the same
#           fields as a function entry.  Below it are listed
#           the members of the cycle, and their contributions
#           to the time and call counts of the cycle.

print "\n";
printf("\n%-8.8s %9.9s  %8.8s %8.8s %12.12s  %-60s %-8.8s", '',      '',      '',     '',            'calls/total', 'parents',  '');
printf("\n%-8.8s %9.9s  %8.8s %8.8s %12.12s  %-60s  %-8.8s", 'index', '%time', 'self', 'descendents', 'calls+self',  'name',     'index');
printf("\n%-8.8s %9.9s  %8.8s %8.8s %12.12s  %-60s %-8.8s", '',      '',      '',     '',            'calls/total', 'children', '');
print "\n";

my $fun;
my %self;

foreach $fun (sort {$time{$b} <=> $time{$a}} (keys %calls)) {
    my $n = $calls{$fun};
    # Either calls should match returns, or be off by one (profiling stopped while in a call).
    if ($n - $rets{$fun} > 1) {
        printf("\n%s: calls %d, rets %d", $fun, $n, $rets{$fun});
    }
    else {
        # Total time in this function
        my $tot = $time{$fun};
        # Percent in this function
        my $perc = $tot*100/$total;
        # Callee times
        my $st = $subtime{$fun};
        # Callers
        my $pc = $supcalls{$fun};
        # Callees
        my $bc = $subcalls{$fun};
        # Returnees
        my $br = $subrets{$fun};
        # Returners
        my $pr = $suprets{$fun};
        # Total time in callees
        my $sub = $subtotal{$fun};
        # Time in self
        my $selftime = $self{$fun} = $tot - $sub;
        # Calls to self
        my $recur = $selfcalls{$fun};
        # Print each caller in order of number of calls to me
        foreach my $parent (sort {$pc->{$b} <=> $pc->{$a}} (keys %$pc)) {
            # Weed out calls != returns
            my $p = $pc->{$parent};
            if ($p != $pr->{$parent}) {
                printf("\n%s: supcalls %d, suprets %d", $parent, $p, $pr->{$parent});
            }
            else {
                # Ratio of calls from this caller
                my $r = $p/$n;
                # Print:
                #  (approx) time in me due to this caller
                #  '' time in my callees '' '' '' ''
                #  no. calls '' '' '' ''
                #  total calls to me
                #  caller name
                #  caller index
                printf("\n%-19s %8.2f %8.2f %6d/%-6d  %-60s [%d]", "", $selftime*$r, $sub*$r, $p, $n, $parent, $index{$parent});
            }
        }
        my $i = $index{$fun};
        # Print:
        #  index
        #  % total program time due to me and my callees
        #  time in me
        #  time in my callees
        #  calls (not including self calls)
        #  self calls
        #  self name
        #  index
        printf("\n%-8s %9.1f%% %8.2f %8.2f %6d+%-6d  %-60s [%d]", "[" . $i . "]", $perc,  $selftime, $sub, $n-$recur, $recur, $fun, $i);
        # Print each callee in order of number of calls from me
        foreach my $child (sort {$st->{$b} <=> $st->{$a}} (keys %$bc)) {
            # Weed out calls != returns
            my $c = $bc->{$child};
            if ($c != $br->{$child}) {
                printf("\n%s: subcalls %d, subrets %d", $child, $c, $br->{$child});
            }
            else {
                # Print:
                #  time in callee due to me
                #  (approx) time in callees callees '' '' ''
                #  no. calls to callee '' '' ''
                #  total calls to callee
                #  callee name
                #  callee index
                my $n = $calls{$child};
                # accurate
                my $tot = $st->{$child};
                my $tc = $time{$child};
                my $r = $tc ? $tot/$tc : 1;
                # approx
                my $sub = $subtotal{$child} * $r;
                my $self = $tot - $sub;
                printf("\n%-19s %8.2f %8.2f %6d/%-6d  %-60s [%d]", "", $self, $sub, $c, $n, $child, $index{$child});
            }
        }
        print "\n";
        printf "\n------------------------------------------------------------------------------------------------------------------------";
        print "\n";
    }
}

print "\n\cL\n";

# Output flat profile

# [From gprof]
print "
flat profile:


 %         the percentage of the total running time of the
time       program used by this function.

cumulative a running sum of the number of seconds accounted
 seconds   for by this function and those listed above it.

 self      the number of seconds accounted for by this
seconds    function alone.  This is the major sort for this
           listing.

calls      the number of times this function was invoked, if
           this function is profiled, else blank.

 self      the average number of milliseconds spent in this
ms/call    function per call, if this function is profiled,
           else blank.

 total     the average number of milliseconds spent in this
ms/call    function and its descendents per call, if this
           function is profiled, else blank.

name       the name of the function.  This is the minor sort
           for this listing. The index shows the location of
           the function in the gprof listing. If the index is
           in parenthesis it shows where it would appear in
           the gprof listing if it were to be printed.
";

my $cumulative = 0;

print "\n";
printf("\n%9.9s  %10.10s %8.8s %8.8s %8.8s %8.8s  %-60s  %-8.8s",    '%','cumulative',    'self', 'calls',    'self',   'total', 'name', 'index');
printf("\n%9.9s  %10.10s %8.8s %8.8s %8.8s %8.8s  %-60s  %-8.8s", 'time',   'seconds', 'seconds',      '', 'ms/call', 'ms/call',     '', '');
print "\n";

foreach $fun (sort {$self{$b} <=> $self{$a}} (keys %calls)) {
    my $selftime = $self{$fun};
    my $perc = $selftime*100/$total;
    $cumulative += $selftime;
    my $calls = $calls{$fun} - $selfcalls{$fun};
    my $selfpercall = $selftime/$calls;
    my $totalpercall = $time{$fun}/$calls;
    my $i = $index{$fun};
    printf("\n%9.1f%% %10.2f %8.2f %8d %8.2f %8.2f  %-60s  [%d]", $perc,  $cumulative/1000.0, $selftime/1000.0, $calls, $selfpercall, $totalpercall, $fun, $i);
}

print "\n\cL\n";

# Output index

print "\nIndex by function name:";
print "\n";

foreach $fun (sort {lc($a) cmp lc($b) or $a cmp $b} (keys %index)) {
    # Don't truncate anything here
    printf("\n%-8s %-60s", '[' . $index{$fun} . ']', $fun);
}

print "\n\cL\n";

# Output event log

print "\nEvent log:";
print "\n";

my $previous = 0;
my $cumulative = 0;
foreach $timestamp (sort { $a <=> $b } (keys %log)) {
    my $msg = $log{$timestamp};
    if ($previous == 0) {
        $previous = $timestamp;
    }
    my $delta = $timestamp - $previous;
    $previous = $timestamp;
    $cumulative += $delta;
    printf("\n%8.2f %+8.2f %-60s", $cumulative/1000.0, $delta, $msg );
}

print "\n\n";