#!/usr/bin/env perl
# 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=>0, -output=>\*STDOUT);
    exit(1);  # Unreachable
}

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 ....
  {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.

For documentation see
L<https://verilator.org/guide/latest/exe_verilator_profcfuncs.html>.

=head1 ARGUMENT SUMMARY

    <filename>  Input file (gprof.out)
    --help      Display this help

=head1 DISTRIBUTION

The latest version is available from L<https://verilator.org>.

Copyright 2007-2021 by Wilson Snyder. This program 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.

SPDX-License-Identifier: LGPL-3.0-only OR Artistic-2.0

=head1 SEE ALSO

C<verilator>

and L<https://verilator.org/guide/latest/exe_verilator_profcfuncs.html> for
detailed documentation.

=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:
