lineuse.pl

# perf script event handlers, generated by perf script -g perl
# Licensed under the terms of the GNU GPL License version 2

# The common_* event handler fields are the most useful fields common to
# all events.  They don't necessarily correspond to the 'common_*' fields
# in the format files.  Those fields not available as handler params can
# be retrieved using Perl functions of the form common_*($context).
# See Context.pm for the list of available functions.

use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
use lib "./Perf-Trace-Util/lib";
use Perf::Trace::Core;
use Perf::Trace::Context;
use Perf::Trace::Util;
use bigint qw(hex);
use Spreadsheet::WriteExcel;
use File::Temp qw(tempfile);
use integer;

my %linehash;
my %branchhash;
my $exec_name;

sub trace_begin
{
    # optional
}

sub trace_end
{
    if (!$exec_name) {
        $exec_name = $ENV{'LINEUSE_EXEC_NAME'};
    }
    my @branchhash_keys = sort { $a <=> $b } keys %branchhash;

    foreach my $line (sort { $a <=> $b } keys %linehash) {
        my @color=();
        for(my $i=0; $i<64; $i++) {
            $color[$i]=0;
        }
        foreach my $range (keys $linehash{$line}) {
            if ($range eq "count") {
                next;
            }

            my ($from,$upto) = split(/->/,$range);
            my $start = $from & 0x3F;
            my $end = $upto & 0x3F;
            # Color the array with all ranges you found, takes care of overlap
            for(my $j=$start; $j<=$end; $j++) {
                $color[$j] = 1;
            }

            # count up branch instructions (fallthrough and taken)
            for (my $k=0; $k < @branchhash_keys; $k++) {
                my $address = $branchhash_keys[$k];
                if ($address < $line) {
                    splice @branchhash_keys, $k, 1;
                    $k--;
                } elsif ($address >= $from && $address <= $upto) {
                    $branchhash{$address}{"total"} += $linehash{$line}{$range};
                } elsif ($address > ($line + 0x3f)) {
                    last;
                }
            }
        }
        # Count the number of 1's in the array
        my $sum=0;
        for (my $j=0; $j<64; $j++) {
            $sum += $color[$j];
        }
        $linehash{$line}{"use"}=$sum;
    }
    printresults();
}

# Packed byte string args of process_event():
#
# $event:      union perf_event        util/event.h
# $attr:       struct perf_event_attr  linux/perf_event.h
# $sample:     struct perf_sample      util/event.h
# $raw_data:   perf_sample->raw_data   util/event.h

sub process_event
{
    my ($event, $attr, $sample, $raw_data) = @_;

    # type, misc, size, event specific data
    my @event    = unpack("LSSa*", $event);

    use Data::Dumper;

    # Unfortunately perf doesn't seem to pass through
    # this event, so for now we rely on an environment variable.
    if (@event[0] == 1) {
        if (!$exec_name) {
            # pid, tid, size, addr, len, pgoff, filename
            my @perf_sample = unpack("LLQQQZ*", @event[3]);
            my $pid = @perf_sample[0];
            if ($pid != -1) {
                $exec_name = @perf_sample[6];
            }
        }
    }

    if (@event[0] == 9) {
        # IP, pid, tid, sample id, number of samples, samples
        my @perf_sample = unpack("QLLQQa*", @event[3]);
        my $lbr_number = @perf_sample[4];
        my $lbr_ptr = @perf_sample[5];
        my @from=();
        my @to=();

        for (my $i=0; $i < $lbr_number; $i++) {
            # from, to, flags
            my @lbr_data = unpack("QQQa*", $lbr_ptr);
            my $from = @lbr_data[0];
            my $to = @lbr_data[1];
            my $flags = @lbr_data[2];
            $lbr_ptr = @lbr_data[3];

            # Get rid of "empty" stack values
            if (($from == 0) && ($to == 0)) {
                next;
            }
            # Store the ip in order to get BB lengths later
            push (@from,$from);
            push (@to,$to);

            # Check for the mispredicted branch bit. Don't use the
            # last entry as it will not be part of any execution
            # range. (We don't want to count more mispredicts than
            # total branches counted.)
            if (($i != 15) && ($flags & 1)) {
                $branchhash{$from}{"count"}++;
            }
        }

        # Iterate through all the TO:FROM in reverse
        for (my $i=$#from; $i>=1; $i--) {
            # Calculate Basic Block length
            my $bbstart = $to[$i];
            my $bbend = $from[$i-1];
            $bbstart = $to[$i];
            $bbend = $from[$i-1];

            # The "from" in the LBR is the start of the branch instruction
            # Assume branch instruction to be an average of 3 bytes long
            # (1 is already counted)
            $bbend   = $bbend + 2;

            my $startline = $bbstart & 0xffffffffffffffc0;
            my $endline = $bbend;

            my $delta = $endline - $startline;
            my $numlines = ($delta + 64) / 64;

            my $entry;
            my $egress;
            # Generate all entry and exit points within each cacheline
            foreach (my $i=0;$i<$numlines;$i++) {
                my $line = $startline + 64 * $i;

                ### Find entry within a cacheline ###
                if ($i == 0) {
                    $entry = $bbstart;    # Entry for first line
                } else {
                    $entry = $line;
                }
                ### Find exit within a cacheline ###
                if ($i == ($numlines - 1)) {
                    $egress = $endline;    # Exit for last line
                }
                else {
                    $egress = $line + 0x3F;
                }
                $linehash{$line}{"$entry->$egress"}++;
                $linehash{$line}{"count"}++;
            }
        }
    }
}

sub printresults {
    ###################### Set Worksheet properties ######################
    my $excel_file = Spreadsheet::WriteExcel->new("lineuse.xls");
    my $format_num1 = percent_format($excel_file);
    my $format_num2 = num_format($excel_file);
    my $format_head = head_format($excel_file);
    my $format_text = text_format($excel_file);
    my $format_flag = flag_format($excel_file);

    my $text_file = "lineuse.csv";
    open(F, ">$text_file") || die "could not write to file $text_file\n";
    my $usesheet = $excel_file->add_worksheet("LBR_Lineuse");
    # LBR sheet
    $usesheet->set_row(0,16, $format_head);
    $usesheet->set_column(0,10,22, $format_text);
    #$lbrsheet->set_column(2,2,15, $format_num1);
    ######################################################################
    # Dump to Excel sheet
    ######################################################################
    my $row=0;
    my $header = "Cacheline\tFunction\tSource line\tBytesUsed\tHits\tPoor Use";
    my @useheader = split(/\t/,$header);
    $usesheet->write_row($row++, 0, \@useheader);
    print F "${header}\n";
    my $size = (keys %linehash) + 1;
    my $formula = $usesheet->store_formula(
        "=1*AND((D2<=32),(E2>0.001*SUM(E\$1:E\$$size)))");
    my @linehash_keys = sort { $a <=> $b } keys %linehash;
    my $addrs_file = new File::Temp(UNLINK => 1);
    foreach my $line (@linehash_keys) {
        printf $addrs_file "0x%016X\n", $line;
    }
    my $symbolfile_available = -f $exec_name;
    if ($symbolfile_available) {
        my $symbols_file = new File::Temp(UNLINK => 1);
        system("addr2line -e $exec_name -f -C < $addrs_file > $symbols_file");
        open(SF, "<$symbols_file");
    } elsif ($exec_name) {
        print("Executable file $exec_name not found!\n");
        print("Proceeding without symbol information.\n");
    }
    else {
        print("Unable to determine executable file name!\n");
        print("Please set the LINEUSE_EXEC_NAME environ variable.\n");
        print("Proceeding without symbol information.\n");
    }
    foreach my $line (@linehash_keys) {
        my @values=();
        my $function_name;
        my $source_line;
        if ($symbolfile_available) {
            $function_name = <SF>;
            $source_line = <SF>;
        } else {
            $function_name = "??";
            $source_line = "??:?";
        }
        my $hexline = sprintf("0x%016X", $line);
        push (@values, "$hexline", "$function_name", "$source_line", "$linehash{$line}{\"use\"}",
            "$linehash{$line}{\"count\"}");
        $usesheet->write_row($row, 0, \@values);
        my $one_based_row = $row + 1;
        $usesheet->repeat_formula($row, 5, $formula, $format_flag, 'D2', 'D'.($one_based_row),
            'E2', 'E'.($one_based_row));
        $row++;
        print F "$hexline\t$function_name\t$source_line\t$linehash{$line}{\"use\"}\t$linehash{$line}{\"count\"}\n";
    }
    close(SF);
    close(F);

    $text_file = "mispredicts.csv";
    open(F, ">$text_file") || die "could not write to file $text_file\n";
    $usesheet = $excel_file->add_worksheet("LBR_BranchMispredicts");
    # Branch mispredict sheet
    $usesheet->set_row(0,16, $format_head);
    $usesheet->set_column(0,10,22, $format_text);
    ######################################################################
    # Dump to Excel sheet
    ######################################################################
    $row=0;
    $header = "Address\tFunction\tSource line\tMispredictions\tTotal uses\tMisprediction rate";
    @useheader = split(/\t/,$header);
    $usesheet->write_row($row++, 0, \@useheader);
    print F "${header}\n";
    $formula = $usesheet->store_formula("=D2/E2");
    my @branchhash_keys = sort { $a <=> $b } keys %branchhash;
    $addrs_file = new File::Temp(UNLINK => 1);
    foreach my $line (@branchhash_keys) {
        printf $addrs_file "0x%016X\n", $line;
    }
    if ($symbolfile_available) {
        my $symbols_file = new File::Temp(UNLINK => 1);
        system("addr2line -e $exec_name -f -C < $addrs_file > $symbols_file");
        open(SF, "<$symbols_file");
    }
    foreach my $address (@branchhash_keys) {
        my @values=();
        my $misses = 0;
        if (defined $branchhash{$address}{"count"}) {
            $misses = $branchhash{$address}{"count"};
        }
        my $function_name;
        my $source_line;
        if ($symbolfile_available) {
            $function_name = <SF>;
            $source_line = <SF>;
        } else {
            $function_name = "??";
            $source_line = "??:?";
        }
        my $hexaddress = sprintf("0x%016X", $address);
        push (@values, "$hexaddress", "$function_name", "$source_line", "$misses",
            "$branchhash{$address}{\"total\"}");
        print F "$hexaddress\t$misses\t$branchhash{$address}{\"total\"}\n";
        $usesheet->write_row($row, 0, \@values);
        my $one_based_row = $row + 1;
        $usesheet->repeat_formula($row, 5, $formula, $format_text, 'D2', 'D'.($one_based_row),
            'E2', 'E'.($one_based_row));
        $row++;
    }
    close(SF);
    close(F);

    $usesheet = $excel_file->add_worksheet("Summary");
    # Summary data sheet
    $usesheet->set_column(0,10,45, $format_text);
    ######################################################################
    # Dump to Excel sheet
    ######################################################################
    $row=0;
    my @values=();
    push (@values, "avg cache line use\:", "=AVERAGE(LBR_Lineuse\!D:D)/64");
    $usesheet->write_row($row++, 0, \@values);
    @values=();
    push (@values, "weighted avg cache line use\:", "=SUMPRODUCT(LBR_Lineuse\!D:D,LBR_Lineuse\!E:E)/SUM(LBR_Lineuse\!E:E)/64");
    $usesheet->write_row($row++, 0, \@values);
    $row++;
    @values=();
    push (@values, "avg mispredict rate\:", "=AVERAGE(LBR_BranchMispredicts\!F:F)");
    $usesheet->write_row($row++, 0, \@values);

    $excel_file->close();
}

sub head_format {
    my $wkbk = shift;
    my $format;
    if ( $wkbk ) {
        $format = $wkbk->add_format();
    } else {
        $format = $main::workbook->add_format();
    }
    $format->set_align('left');
    $format->set_bold();
    $format->set_size(11);
    return($format);
}
sub text_format {
    my $wkbk = shift;
    my $format;
    if ( $wkbk ) {
        $format = $wkbk->add_format();
    } else {
        $format = $main::workbook->add_format();
    }
    $format->set_align('left');
    $format->set_size(9);
    return($format);
}
sub percent_format {
    my $wkbk = shift;
    my $format;
    if ( $wkbk ) {
        $format = $wkbk->add_format();
    } else {
        $format = $main::workbook->add_format();
    }
    $format->set_align('left');
    $format->set_size(9);
    $format->set_num_format('[Blue]0.000%');
    return($format);
}
sub num_format {
    my $wkbk = shift;
    my $format;
    if ( $wkbk ) {
        $format = $wkbk->add_format();
    } else {
        $format = $main::workbook->add_format();
    }
    $format->set_align('left');
    $format->set_size(9);
    $format->set_num_format('[Blue]0.000');
    return($format);
}
sub int_format {
    my $wkbk = shift;
    my $format;
    if ( $wkbk ) {
        $format = $wkbk->add_format();
    } else {
        $format = $main::workbook->add_format();
    }
    $format->set_align('left');
    $format->set_size(9);
    $format->set_num_format('[Blue]0');
    return($format);
}
sub flag_format {
    my $wkbk = shift;
    my $format;
    if ( $wkbk ) {
        $format = $wkbk->add_format();
    } else {
        $format = $main::workbook->add_format();
    }
    $format->set_align('left');
    $format->set_size(9);
    $format->set_num_format('[Red]<---------; ; ');
    return($format);
}