: # -*-Mode: perl;-*- use perl, wherever it is
eval 'exec perl -wS $0 ${1+"$@"}'
  if 0;
# See copyright, etc in below POD section.
######################################################################

require 5.006_001;
use warnings;
use Getopt::Long;
use IO::File;
use Pod::Usage;
eval { use Data::Dumper;  $Data::Dumper::Indent = 1; }; # Debug, ok if missing
use strict;
use vars qw ($Debug);

#======================================================================


#======================================================================
# main

$Debug = 0;
my $Opt_File;
autoflush STDOUT 1;
autoflush STDERR 1;
Getopt::Long::config ("no_auto_abbrev");
if (! GetOptions (
		  "help"	=> \&usage,
		  "debug"	=> \&debug,
		  "<>"		=> \&parameter,
		  )) {
    die "%Error: Bad usage, try 'verilator_profcfunc --help'\n";
}

defined $Opt_File or die "%Error: No filename given\n";

profcfunc($Opt_File);

#----------------------------------------------------------------------

sub usage {
    pod2usage(-verbose=>2, -exitval=>2, -output=>\*STDOUT);
    exit (1);
}

sub debug {
    $Debug = 1;
}

sub parameter {
    my $param = shift;
    if (!defined $Opt_File) {
	$Opt_File = $param;
    } else {
	die "%Error: Unknown parameter: $param\n";
    }
}

#######################################################################

sub profcfunc {
    my $filename = shift;
    # Remove hex numbers before diffing
    my $fh = IO::File->new ($filename) or die "%Error: $! $filename,";

    my %funcs;

    while (defined (my $line=$fh->getline())) {
	#                  %time      cumesec   selfsec     calls     {stuff}   name
	if ($line =~ /^\s*([0-9.]+)\s+[0-9.]+\s+([0-9.]+)\s+([0-9.]+)\s+[^a-zA-Z_]*([a-zA-Z_].*)$/) {
	    my $pct=$1; my $sec=$2; my $calls=$3; my $func=$4;
	    $funcs{$func}{pct} += $pct;
	    $funcs{$func}{sec} += $sec;
	    $funcs{$func}{calls} += $calls;
	}
        # Older gprofs have no call column for single-call functions
        #                  %time      cumesec   selfsec      {stuff}   name
        elsif ($line =~ /^\s*([0-9.]+)\s+[0-9.]+\s+([0-9.]+)\s+[^a-zA-Z_]*([a-zA-Z_].*)$/) {
            my $pct=$1; my $sec=$2; my $calls=1; my $func=$3;
            $funcs{$func}{pct} += $pct;
            $funcs{$func}{sec} += $sec;
            $funcs{$func}{calls} += $calls;
        }
    }
    $fh->close;

    # Find modules
    my %pointer_mods;
    my %verilated_mods;
    foreach my $func (keys %funcs) {
	if ($func =~ /(.*)::_eval\(([a-zA-Z_0-9]+__Syms).*\)$/) {
	    $verilated_mods{$1} = qr/^$1/;
	    $pointer_mods{$2} = $1;
	}
    }
    #print Dumper(\%pointer_mods, \%verilated_mods);

    # Resort by Verilog name
    my %vfuncs;
    my %groups;
    foreach my $func (keys %funcs) {
	my $pct = $funcs{$func}{pct};
	my $vfunc = $func;
	my $design;

	if ($func =~ /\(([a-zA-Z_0-9]+__Syms)/) {
	    $design = $pointer_mods{$1};
	}

	foreach my $vde (keys %verilated_mods) {
	    last if $design;
	    if ($func =~ /$verilated_mods{$vde}/) {
		$design=$vde;
		last;
	    }
	}

	if ($vfunc =~ /__PROF__([a-zA-Z_0-9]+)__l?([0-9]+)\(/) {
	    $vfunc     = sprintf("VBlock    %s:%d", $1, $2);
	    $groups{type}{"Verilog Blocks under $design"} += $pct;
	    $groups{design}{$design} += $pct;
	    $groups{module}{$1} += $pct;
	} else {
	    if ($design) {
		$vfunc = sprintf("VCommon   %s", $func);
		$groups{type}{"Common code under $design"} += $pct;
		$groups{design}{$design} += $pct;
		$groups{module}{$design." common code"} += $pct;
	    } elsif ($func =~ /^VL_[A-Z0-9_]+/
		     || $func =~ /^_?vl_[a-zA-Z0-9_]+/
		     || $func =~ /^verilated/i) {
		$vfunc = sprintf("VLib      %s", $func);
		$groups{type}{'VLib'} += $pct;
		$groups{design}{'VLib'} += $pct;
		$groups{module}{'VLib'} += $pct;
	    } elsif ($func =~ /^_mcount_private/) {
		$vfunc = sprintf("Prof      %s", $func);
		$groups{type}{'Prof'} += $pct;
		$groups{design}{'Prof'} += $pct;
		$groups{module}{'Prof'} += $pct;
	    } else {
		$vfunc = sprintf("C++       %s", $func);
		$groups{type}{'C++'} += $pct;
		$groups{design}{'C++'} += $pct;
		$groups{module}{'C++'} += $pct;
	    }
	}
	$vfuncs{$vfunc} = $funcs{$func};
    }


    foreach my $type (qw(type design module)) {
	my $missing = 100;
	foreach (sort (keys %{$groups{$type}})) {
	    $missing -= $groups{$type}{$_};
	}
	if ($missing) {
	    $groups{$type}{"\377Unaccounted for/rounding error"} = $missing;
	}

	print("Overall summary by $type:\n");
	printf("  %-6s  %s\n","% time",$type);
	foreach my $what (sort (keys %{$groups{$type}})) {
	    (my $pwhat = $what) =~ s/^\377//;  # Just used to establish sort order
	    printf("  %6.2f  %s\n", $groups{$type}{$what}, $pwhat);
	}
	print("\n");
    }

    print("Verilog code profile:\n");
    print("   These are split into three categories:\n");
    print("      C++:     Time in non-Verilated C++ code\n");
    print("      Prof:    Time in profile overhead\n");
    print("      VBlock:  Time attributable to a block in a Verilog file and line\n");
    print("      VCommon: Time in a Verilated module, due to all parts of the design\n");
    print("      VLib:    Time in Verilated common libraries, called by the Verilated code\n");
    print("\n");

    print("  %   cumulative   self              \n");
    print(" time   seconds   seconds    calls   type      filename and line number\n");

    my $cume = 0;
    foreach my $func (sort {$vfuncs{$b}{sec} <=> $vfuncs{$a}{sec}
			    || $a cmp $b}
		      (keys %vfuncs)) {
	$cume += $vfuncs{$func}{sec};
	printf +("%6.2f %9.2f %8.2f %8d   %s\n",
		 $vfuncs{$func}{pct},
		 $cume, $vfuncs{$func}{sec},
		 $vfuncs{$func}{calls},
		 $func);
    }
}

#######################################################################
__END__

=pod

=head1 NAME

verilator_profcfunc - Read gprof report created with --prof-cfuncs

=head1 SYNOPSIS

  verilator --prof-cfuncs ....
  gcc --ggdb -pg ....
  {run executable}
  gprof
  verilator_profcfuncs gprof.out

=head1 DESCRIPTION

Verilator_profcfunc reads a profile report created by gprof.  The names of
the functions are then transformed, assuming the user used verilator's
--prof-cfuncs, and a report printed showing the percentage of time, etc,
in each Verilog block.

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=back

=head1 DISTRIBUTION

The latest version is available from L<http://www.veripool.org/>.

Copyright 2007-2018 by Wilson Snyder.  Verilator is free software; you can
redistribute it and/or modify it under the terms of either the GNU Lesser
General Public License Version 3 or the Perl Artistic License Version 2.0.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

C<verilator>

=cut

######################################################################
### Local Variables:
### compile-command: "$V4/bin/verilator_profcfunc  $V4/test_c/obj_dir/V*_03_*.tree $V4N/test_c/obj_dir/V*_03_*.tree"
### End:
