#!/usr/bin/perl
# Convert `dprof -b` (DPROF BACKTRACE) output into pprof-like binary format version 0 (pprof is from google-perftools, gperftools on code.google.com)
# Usage:
#  dprof -b -P -o dprof.output ... ./program
#
#  dprof2pprof dprof.output pprof.out  
#
# dprof.output is input; pprof.out.* is output in pprof format
#
# Or filter only one PID
#  dprof2pprof dprof.output pprof.out PID
#
# Several pprof.out.* files can be generated with suffix Event_Count:
#
#  pprof ./program ./pprof.out.Event_Count
# 
# To move pprof file to x86 machine, use: 
#  pprof --raw ./program ./pprof.out.Event_Count > ./program.raw
#
# x86$ pprof program.raw
#
# Breger@mcst.ru

=pod

=head1 dprof2pprof

Script to convert form dprof output into pprof-like format which can be parsed by pprof script from gperftools.

=head2 Usage

dprof2pprof dprof.output pprof.prefix [PID]

options:
 dprof.output - file name of dprof output
 pprof.prefix - file prefix for generated pprof-formatted data
 PID          - optional filter of process id

dprof2pprof --help 
 Print short help

dprof2pprof --version
 Print version

=head2 Features

Can handle dprof output of modes:

* Timer-based (dprof -i 10; default mode)
* HW event-based (dprof -e EVENT1:FREQ), both single event and multi event
* Combined timer and HW-events (dprof -i 10 -e EVENT1:FREQ)

If dprof was started with -b (record backtrace of each event), the call graph information is generated by this script.

If dprof was started with -P (implied by -b), dprof will dump /proc/pid/maps file in the output; this script will separate ELF objects based on addresses and maps.

Line information about sources will be shown only if application contains debug information (usually when -g option is used to compile application).

=head2 Requests

To use pprof, objdump from binutils is needed.

When `-P` option of dprof is used, all dynamic libraries with full path should be readable by pprof script. Path must be same as at moment of running the application. 

Alternatively, pprof --raw can be used on the machine which have objdump and libraries with original paths. After running --raw, symbol information will be embedded into output file:

 pprof --raw ./program ./program.pprof > ./program.raw 

program.raw can be analyzed in cross-environment, but for disasm output the objdump and binaries are still needed. 

=cut

use strict;
my $dprof_out;
my $output_prefix;
my $maps = "";
my %events;
my %event_names;

my $pidfilter;
my %pid_used;

my $stacks_present = 1;
my $eventcount = 0;

# Write small usage example
sub usage()
{
    print <<USAGE

dprof2pprof - utility to convert dprof output into pprof-like format
Usage: dprof2pprof dprof.output pprof_output [PID]
 dprof.output - file with output of dprof -b or dprof -P (for dynamic programs)
 pprof_output - prefix for output files (one file per event)
 PID          - optional filter of process id
USAGE
;
    exit;
}

sub version()
{
    print <<VERSION

dprof2pprof - utility to convert dprof output into pprof-like format
VERSION
;
    print 'Revision: $Revision: 1.6 $'."\n";
    print 'Date of build: $Date: 2013-07-05 16:07:14 $'."\n";
    exit;
}

#######



# Check the line for additional info from dprof
# Call from while(<dprof_out>)
sub read_dprof_info_line($) {
    $_ = shift;
# [23701] DPROF_PROC_MAPS NEW aaaaafd1000-aaaab05e000 r-xp 00000000 03:03 326421                       /lib64/libm-2.7.so
    /DPROF_PROC_MAPS NEW/ && /^\[\d+\] DPROF_PROC_MAPS NEW ([0-9a-f]+-[0-9a-f]+ .... [0-9a-f]+ [0-9a-f]+:[0-9a-f]+ \d+\s+\S*)$/ && do {
        $maps .= $1;
        # Restore line break after chomp;
        $maps .= "\n";
    }
}

# add_event: $event_name, $addr_list
sub add_event($$) {
    my $event_name = shift @_;
    my $addr_list = shift @_;
    $addr_list=~s/^\s+//;
    $addr_list=~s/\s+$//;
    if($addr_list =~ /^$/){return;}
  
    # total event count
    $eventcount++;

    # per-type event count
    $event_names{$event_name}++;
    # current backtrace count
    $events{$event_name}{$addr_list}++;

}

# output events by events_name
# from hash {text_backtrace}->count
# Args: event_name, bitness
sub output_event($$) {
    my $event_name = shift;
    my $mode = shift; # 32 or 64
#
# The binary profile record format is shown below. 
# slot   data
# 0  sample count, must be >= 1
# 1  number of call chain PCs (num_pcs), must be >= 1
# 2 .. (num_pcs + 1) call chain PCs, most-recently-called function first.

    if($mode == 64) {

      # For each backtrace line:
      for my $addr_list(keys %{$events{$event_name}}) {
        my $sample_count= $events{$event_name}{$addr_list};
        #64bit
        print PP pack('L*', $sample_count, 0); #sample count is 32-bit(lsw)+32-bit(msw)
        #TODO support counts > 4g
       
        # split backtrace line
        my @chain = split(/\s+/, $addr_list);
        print PP pack('L*', 1+$#chain, 0); #chain size
        
        for(@chain) {
            if(length($_) > 16) { print STDERR "Invalid address in profile: $_\n"; next;}
            my $low = substr($_, -8); # last 8 nibbles
            my $high = substr($_, -16, 8); # first up to 8 nibbles;
            print PP pack('L*', hex("0x".$low), hex("0x".$high) );
        }
      }

    } else {

      # For each backtrace line:
      for my $addr_list(keys %{$events{$event_name}}) {
        my $sample_count= $events{$event_name}{$addr_list};
        #32bit
        print PP pack('L*', $sample_count);
       
        # split backtrace line
        my @chain = split(/\s+/, $addr_list);
        print PP pack('L*', 1+$#chain); #chain size
        
        for(@chain) {
            if(length($_) > 16) { print STDERR "Invalid address in profile: $_\n"; next;}
            my $low = substr($_, -8); # last 8 nibbles
            print PP pack('L*', hex("0x".$low) );
        }
      }


    }
}

#
# Try to read dprof output with backtraces enabled
sub read_dprof_backtrace() {
    open D, "< $dprof_out";
    while(<D>){
        chomp;
        # Filter unneeded pid
        next if ! /$pidfilter/;
        # skip lines withour DPROF keyword.
        next if ! /DPROF/;
        # Parse /proc/../maps info (-P flag)
        read_dprof_info_line($_) if /DPROF_PROC/;
        # Parse setitimer event
        next if ! /DPROF-BACKTRACE/;
        /^\[(\d+)\] DPROF-BACKTRACE \(depth=\d+\): (.*)/ && do {
#           s/^\[(\d+)\] DPROF-BACKTRACE \(depth=\d+\): //;
            $pid_used{$1}++;
            add_event("Timer", $2);
        };
        # Parse hardware event
        /^\[(\d+)\] DPROF-BACKTRACE EVENT (\S+) \(depth=\d+\): (.*)/ && do {
#            s/^\[(\d+)\] DPROF-BACKTRACE EVENT (\S+) \(depth=\d+\): //;
            $pid_used{$1}++;
            add_event($2, $3);
        };
    }
    close D;
    return $eventcount;
}

# Try to read dprof output with backtraces disabled
# old-style dprof
sub read_dprof_flat() {
    open D, "< $dprof_out";
    while(<D>){
        chomp;
        # Filter unneeded pid
        next if ! /$pidfilter/;
        # Parse /proc/../maps info (-P flag)
        read_dprof_info_line($_) if /DPROF_PROC/;
        # Parse setitimer event
        /^\[(\d+)\] (0[0-9a-fA-F]+)/ && do {
#            s/^\[\d+\] //;
            $pid_used{$1}++;
            add_event("Timer0_flat", $2);
        };
        # Parse hardware event
        /^\[(\d+)\] event (\S+) \(\S+\) at (0[0-9a-fA-F]+)/ && do {
#            s/^\[\d+\] event (\S+) \(\S+\) at //;
            $pid_used{$1}++;
            add_event($2."_flat", $3);
        };
    }
    close D;
    return $eventcount;
}

# Check is the file 32bit or 64bit
sub is_64_bit() {
    for my $k(keys %events){
        for(keys %{$events{$k}}){
            # There is 64-bit address with more than 8 nibbles set
            if(m/0+[1-9a-f][0-9a-f]{8,}/) { 
                return 64; 
            }
        }
    }
    return 32;
}

# output_pprof: $event_name $bitness
# write single Event type to pprof format
sub output_pprof($$) {
    my $event_name = shift;
    my $mode = shift; # 32 or 64

    my $out_file = $output_prefix.".".$event_name;
    $out_file =~ tr/:/_/;

    if($stacks_present) {
      print STDERR "Event $event_name (".$event_names{$event_name}." events; ".
                  scalar(keys %{$events{$event_name}})." stacks): write to $out_file\n";
    } else {
      print STDERR "Event $event_name (".$event_names{$event_name}." events; ".
                  scalar(keys %{$events{$event_name}})." flat records): write to $out_file\n";
    }

    open PP, ">$out_file";
    binmode PP;

    
    # print header 
    if( $mode == 64) {
        # (64-bit style)
        # (zero)  (header-size=3)  (version=0)  (sample-period)  (zero)
        print PP pack('L*',   0, 0,   3, 0,   0, 0,   100, 0,   0, 0);

        #32bit
        #print PP pack('L*', 0,  3,  0, 100, 0);
     
        output_event($event_name, $mode);

        # chains end marker
        print PP pack('L*', 0, 0, 1, 0, 0, 0);

    } else {
        #32bit
        # (zero)  (header-size=3)  (version=0)  (sample-period)  (zero)
        print PP pack('L*',   0,   3,   0,   100,   0);
     
        output_event($event_name, $mode);

        # chains end marker
        print PP pack('L*', 0, 1, 0);

    }
    print PP "\n";
    print PP $maps;
    close PP;
}

# Main function.
#  Read dprof output,
#   count distinct backtraces for each event
#  Output each event into separate pprof file 
sub main() {

    if($ARGV[0] =~ /^-/) { 
        my $opt = shift @ARGV;
        ($opt =~ /^--?[hH]/) && do { usage(); };
        ($opt =~ /^--?version/) && do { version(); };
    } 

    if(($#ARGV+1 != 2) && ($#ARGV+1 != 3)) { usage(); }
    $dprof_out = $ARGV[0];
    $output_prefix = $ARGV[1];

    # Setup pidfilter: Any pid or pid from ARGV[2] if given
    $pidfilter="^\\[\\d+\\]";
    if($#ARGV+1 == 3) {
        $pidfilter = "^\\[".$ARGV[2]."\\]";
    }


    # Read input as backtrace-enabled (e90- and e2k-only, with "-b" option)
    if(read_dprof_backtrace() == 0) {
        $stacks_present=0;
        # Failed; reread input as flat (e90 or e2k without -b)
        if(read_dprof_flat() == 0) {
            # Both methods failed.
            print "No input detected in $dprof_out file\n";
            usage();
        }
    }

    my $bitness = is_64_bit();

    for my $e(keys %event_names){
        output_pprof($e, $bitness);
    }

    print STDERR "Total event count on output: $eventcount\n";
    # print "$_:", $event_names{$_}," " for(@event_names)
    my $pid_count = keys %pid_used;
    my @pids = keys %pid_used;
    
    if($pid_count > 1) {
      for(sort {$a <=> $b} @pids) {
        print STDERR " Pid $_ total events: ", $pid_used{$_}, "\n";
        # TODO add per-event pid stats
      }
   }
}
#todo start pprof.e2k --raw ?

# start the main() function
main();

