#!/usr/bin/perl
# Copyright (c) 2012 ZAO "MCST". All rights reserved.
#
# @(#) $Id: dprof2callgrind,v 1.22 2016-01-21 18:37:25 breger Exp $
#
# Convert `dprof -b` (DPROF BACKTRACE) output into callgrind-like format
# Can work with `dprof -P` output from sparc or e2k
#
# Usage: 
#  dprof -b -P -o dprof.output ... ./program 
#
#  dprof2callgrind program dprof.output > callgrind.out.1
# or with PID filter:
#  dprof2callgrind program dprof.output PID > callgrind.out.2 
#
# then (x86)
#  bash;
#  export PATH=/usr/X11R6/bin:/usr/kde/3.5/bin/:$PATH
#  kcachegrind callgrind.out.1
#
# or (e2k)
#  qcachegrind
#
# Breger@mcst.ru

=pod

=head1 dprof2callgrind

Script to convert from dprof output into callgrind-like format, which can be drawn with kcachegrind or qcachegrind or parsed by callgrind_annotate. Data is grouped by functions.

=head2 Usage

dprof2callgrind [options] program dprof.output [PID] > callgrind.out.1

options:
 -C           - demangle C++ names (passed to addr2line)
 program      - path to binary file
 dprof.output - output of dprof
 PID          - optional filter of process id

dprof2callgrind --help 
 Print short help

dprof2callgrind --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)

Calgrind output has function names compressed (as needed for newer kcachegrind)

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 is stored in the callgrind.out if addr2line was able to report it (usually when -g option is used to compile application).

=head2 Requests

addr2line from binutils is needed. Script will use /usr/bin/addr2line on e2k and sparc;
/home/cf/e2k/mcst.rel-i-1.binutils/e2k-generic-linux.cross/bin/e2k-linux-addr2line on x86 (cross tool for e2k)

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

To start this script in cross-environment: work with statically linked application or copy application and all needed libraries (check with `ldd` utility) to some artifical path, e.g. /home/profiling/app_folder and start program using (bash syntax)
"LD_LIBRARY_PATH=/home/profiling/app_folder /home/profiling/app_folder/application parameters"
Then copy this folter to cross machine with same full path.

If some ELF file can not be read at moment of running dprof2callgrind, addresses will be not grouped by function; anonymous function for every address will be generated. Call graph will be not a tree with ~100% at root, but a forest with <100% at main()

=cut

# TODO:
#  find PROC_MAP RESET for pids
#  separate proc maps and globals for pids
#  detect STDOUT redirection with -t STDOUT = true for tty
#   else detect filename with readlink "/proc/self/fd/".fileno(STDOUT)
#   and generate name suffixes
#  detect object unloading (new object intersects in memory)
# ?generate -separate-callers=?? (replace all function names with funct0'caller0'caller1...etc...)

use strict;

# Check for native 64 bit support
use Config;
my $native64 = 0;
($Config{use64bitint} eq "define" || $Config{longsize} >= 8) && ( $native64 = 1 );

# Required to work with 64bit addresses on machines with perl compiled without native 64-bit integers
# Using BigInts will slow down this script several times.
use Math::BigInt;

# hex string to u64
sub u64_from_hex($) {
    my $str = "0x".shift;
    if($native64) { return hex($str); } else { return Math::BigInt->new($str); }
}

# subtract two u64 numbers
sub u64_sub($$) {
    my $a = shift; my $b = shift;
    if($native64) { return $a-$b; } else { return $a->bsub($b); }
}

sub u64_bacmp($$) {
    my $a = shift; my $b = shift;
    if($native64) { return $a <=> $b; } else { return $a->bacmp($b); }
}

sub u64_to_hex($) {
    my $a = shift;
    if($native64) { return sprintf("0x%x",$a);} else { return $a->as_hex();}
}

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

dprof2callgrind - utility to convert dprof output into callgrind-like format
Usage: dprof2callgrind program dprof.output [PID] > callgrind.out.2
Options (insert before program):
    -C   - do C++ names demangle with `addr2line -C'
USAGE
;
    exit;
}

sub version()
{
    print <<VERSION

dprof2callgrind - utility to convert dprof output into callgrind-like format
VERSION
;
    print 'Revision: $Revision: 1.22 $'."\n";
    print 'Date of build: $Date: 2016-01-21 18:37:25 $'."\n";
    exit;
}

#######

    my $prog_name;
    my $dprof_out;

    my $target_binutils_prefix;
    my $ldis_driver;
    
    my $pidfilter; # filter only one (some) pids from input file

    my %addrs; # Set of addresses used; key is stored as string on 32bitperl
    my %a2f; # addr->func_name
    my %f2a; # func_name->addr
    my %a2l; # addr->file_line
    my %a2s; # addr->file_source
    my %a2o; # addr->object
    my %a2oa;# addr-> 0x(addr- obj->baddr)

    my %functs; # function_names
    my %f_compr; # function_names compressed
    my $compr_id=500; # compressed id last used

# Hash of backtraces loaded from input file (add_event)
    my %stacks; # HofAofA - {Event_name} -> {backtrace lines} -> count

    my $pid=0; # some pid from dprof_out to fill header of output file
    my $addr2line_demangle="";  # -C flag for addr2line - C++ demangle

    my %fcalls; # {caller_name} -> {caller_addr} -> {callee_addr} -> {event} = count
    my %fself;  # {func_name} -> {addr} -> {event} = selfcount

    my %total; # total events number (recalculated in output function)
    my %total_i; # total events number (parsed from input file)
    my @events; # list of events

    my %objs; # obj_name -> {baddr,eaddr}
    my @objs; # sorted by baddr []->{obj_name,baddr,eaddr}

########

# add_event: $event_name, $addr_list
# Store backtrace line in %stacks
sub add_event($$) {
    my @addrs;
    my $event_name = shift @_;
    my $addr_list = shift @_;

    $addr_list=~s/^\s+//;
    $addr_list=~s/\s+$//;

    # input count    
    $total_i{$event_name}++;

    # save stack line
    $stacks{$event_name}{$addr_list}++;
}

# mark_used_addrs
# Iterate over all used addresses and mark them as used
sub mark_used_addrs {
    my @addrs;
    for my $event(keys %stacks)
    {
        for my $list(keys %{$stacks{$event}}) 
        {
            # mark address as used
            @addrs = split(/\s+/, $list);
            $addrs{$_}=0 for @addrs;
        }
    }
}

# Check the line for additional info from dprof: $inputline
#  Parse /proc/../maps info
# Call from while(<dprof_out>) + pidfilter
sub read_dprof_info_line($) {
    $_ = shift;
# Example of line from dprof log:
# [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 {
        my $mode = $3;
        my $file_off = u64_from_hex($4);
        my $lib = $5;
        my $b = $1;
        my $e = $2;
        $b =~ s/^0+/0/;
        $e =~ s/^0+/0/;
        # Store both binary/segment name and its rights
        if($lib eq ""){
            $lib="obj_".$b."\0".$mode;
        }elsif($lib eq "[stack]"){
            $lib="stack_".$e."\0".$mode;
        }elsif($lib eq "[heap]"){
            $lib="heap_".$b."\0".$mode;
        }else {
            # Normal binary
            $lib = $lib."\0".$mode;
        }
     #   elsif($mode =~ /^.w../) {
     #       next; #skip rwxp part of each binary ? == PLT section?
     #   }
        # Store all addresses as BigInt - to work with 64bit addrs on 32-bit perl w/o uint64_t
        $objs{$lib}{"baddr"} = u64_from_hex($b);
        # .so libraries are loaded with offset
        if($lib =~ /\.so/) {
            $objs{$lib}{"load_off"} = u64_sub(u64_from_hex($b),$file_off);
        } else {
            $objs{$lib}{"load_off"} = u64_sub(u64_from_hex("0"),$file_off);
        }
        # Address of the end of binary
        $objs{$lib}{"eaddr"} = u64_from_hex($e);
    };
    /^\[(\d+)\] DPROF_PROC_MAPS RESET/ && do {
        print STDERR "Process with pid $1 started; use: dprof2callgrind program dprof.out $1\n";
    }
}

# Try to read dprof output with backtraces enabled
sub read_dprof_backtrace() {
    my $count = 0;
    open D, "< $dprof_out";
    while(<D>){
        chomp;
        # pid filter is active, skip unneeded
        next if ! /$pidfilter/;
        # parse only lines marked with DPROF keyword
        next if ! /DPROF/;
        # parse /proc/../maps dump
        read_dprof_info_line($_) if /DPROF_PROC/;

        next if ! /DPROF-BACKTRACE/;
        /^\[(\d+)\] DPROF-BACKTRACE \(depth=\d+\): / && do {
            s/^\[(\d+)\] DPROF-BACKTRACE \(depth=\d+\): //;
            $pid=$1;
            add_event("Event0", $_);
            $count++;
        };
        /^\[(\d+)\] DPROF-BACKTRACE EVENT (\S+) \(depth=\d+\): / && do {
            s/^\[(\d+)\] DPROF-BACKTRACE EVENT (\S+) \(depth=\d+\): //;
            $pid=$1;
            add_event($2, $_);
            $count++;
        };
    }
    close D;
    return $count;
}

# Try to read dprof output with backtraces disabled
# old-style dprof
sub read_dprof_flat() {
    my $count = 0;
    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=$1;
            add_event("Timer0_flat", $_);
            $count++;
        };
        # Parse hardware event
        /^\[(\d+)\] event (\S+) \(\S+\) at 0[0-9a-fA-F]/ && do {
            s/^\[(\d+)\] event (\S+) \(\S+\) at //;
            $pid=$1;
            add_event($2."_flat", $_);
            $count++;
        };
    }
    close D;
    return $count;
}

# Sort all known binary objects from /proc/../maps by begin_addr
sub sort_objs() {
    for(sort { u64_bacmp($objs{$a}{"baddr"},$objs{$b}{"baddr"})} keys %objs) {
        my $rec= {};
        $rec->{"baddr"}=$objs{$_}{"baddr"};
        $rec->{"eaddr"}=$objs{$_}{"eaddr"};
        $rec->{"load_off"}=$objs{$_}{"load_off"};
        $rec->{"obj_name"}=$_;
        push @objs, $rec;
    }
}

# split part before \0 from obj name
sub print_obj($) {
    my $obj = shift;
    return ((split /\0/,$obj)[0]);
}

# Resolve addr -> function name - using ldis disassembler
# OBSOLETED, only single binary was supported
sub addr_resolve_ldis() {
    my $cmd="$ldis_driver $prog_name"; 
    use IPC::Open2; 
    local (*Reader, *Writer); 
    my $pid = open2(\*Reader, \*Writer, $cmd); 
    close Writer;
    my($cur_f,$cur_a,$cur_l);
    while(<Reader>)
    {
        chomp;
        /^! function '([^']*)'/ && do { 
                                undef $cur_a;undef $cur_l; $cur_f=$1};
        /^\d+<([\da-f]+)>/ && do { 
             my $addr = $1;
             if((defined $cur_a)&&(defined $addrs{$cur_a})&&(defined $cur_l)){
                $a2l{$cur_a}=$cur_l;
             }
             undef $cur_l;$cur_a=$addr;
             if(defined $addrs{$addr}){ 
               $a2f{$addr}=$cur_f; 
               if(not defined $f2a{$cur_f}){
                 $f2a{$cur_f}=$addr;
               }
             }
            };
        /.!\s+(\d+)$/ && do {$cur_l=$1;}; # do an any line of IW
        /^\s*$/ && do { # end of function, is line pending?
             if((defined $cur_a)&&(defined $addrs{$cur_a})&&(defined $cur_l)){
                $a2l{$cur_a}=$cur_l;
             }
        }
    }
    close Reader;
    waitpid($pid,0);

}

# Resolve addr -> function name - using addr2line from binutils
# in: %addrs, $prog_name, @objs
# out: %a2o, %a2oa, %a2f, %a2l, %f2a, %a2s
sub addr_resolve_addr2line() {
    my @addrs = sort keys %addrs;
    my $addr_ind = 0;
    my $obj_dsc;
    use IPC::Open2; 
    local (*Reader, *Writer); 
    # FIXME First object is assumed to be the $progname (?) / not try to use progname if maps are recorded?
    # Iterate over objects
    for$obj_dsc(@objs,{"baddr"=> u64_from_hex("0"), "eaddr"=> u64_from_hex("ffffffffffff"), "obj_name" => $prog_name, "load_off"=> u64_from_hex("0")}) {
        my $baddr = $obj_dsc->{"baddr"};
        my $load_off = $obj_dsc->{"load_off"};
        my $eaddr = $obj_dsc->{"eaddr"};

        # next address is not in this range, check next object
        if ( u64_bacmp(u64_from_hex($addrs[$addr_ind]),$eaddr) >= 0 ) {
            next;
        }

        # Get path to binary file; check is it readable
        my $binfile = print_obj($obj_dsc->{"obj_name"});
        if( -r $binfile )
        {
            # Start addr2line into double pipe
            my $cmd = $target_binutils_prefix."addr2line -e ".$binfile." -f ".$addr2line_demangle; 
            my $pid = open2(\*Reader, \*Writer, $cmd); 

            my $b;

            # @addrs array is sorted; write only addresses from current memory segment.
            # $_ is current address
            for(;($_=$addrs[$addr_ind]),($b= u64_from_hex($_)), ($addr_ind<=$#addrs) && (u64_bacmp($eaddr,$b)>=0) ; $addr_ind++)
            {
                my ($fname, $fline);
                my $c;
                # Subtract load offset
                $c = u64_sub($b,$load_off);

                print Writer u64_to_hex($c)."\n";

                # Mark address $_ as from binary $binfile
                $a2o{$_}=$binfile;
                # Absolute address $_ correcponds to the $b address inside binary
                $a2oa{$_}=u64_to_hex($c);

                $fname = <Reader>; chomp $fname;
                $fline = <Reader>; chomp $fline;
                
                # Was not resolved; store as automatic anonymous function _Unknown_
                # Warning: callgraph will be broken for _Unk* functions, because we don't know
                # TODO detect PLT segment by rwx maps of the exe
                #  function start and function end address
                if ($fname eq "??") {
                    my $shname = $_;
                    $shname =~ s/^0+/0/;
                    $fname = "_Unknown_".$shname;
                }

                # Resolved to function name
                $a2f{$_}=$fname;
                # Fill a2l as zero (not present), because a2l is printed unconditionally to output
                $a2l{$_}=0;
                if(not defined $f2a{$fname}){
                    $f2a{$fname}=$_;
                }

                # No line/source file information from addr2line
                if(($fline =~ /\?\?:0/) || ($fline =~ /\?\?:\?/)) {
                    $a2l{$_}=0; # not present
                    $a2s{$_}="";
                } else {
                    # both source file name and line number
                    if($fline =~ /^([^:]*):(\d+)$/) {
                        $a2s{$_}=$1;
                        $a2l{$_}=$2;
                    } # object name and question mark? binutils-2.23.1
                    elsif ($fline =~ /^([^:]*.o):\?$/) {
                        $a2s{$_}=$1;
                        $a2l{$_}=0;
                    }
                }

        #unknown:
                # Source file was not found by addr2line. Generate pseudo-file for this addr
                if(not defined $a2f{$_}) {
                    my $addr = $_;
                    $addr =~ s/^0+/0/;
                    $a2f{$_}="unk_$addr";  #TODO add basename of obj??
                    $f2a{$a2f{$_}}=$_;
                    $a2l{$_}=0; # not present
                }


            }
            close Writer;
            close Reader;
            waitpid($pid,0);
        } # if -r binfile
        else 
        {
            # Binary was not found; resolve all addresses as short anonymous pseudo-functions
            # FIXME: is it possible to merge functions to save connectivity of the graph?
            my $basename = $binfile;
            $basename =~ s/^.*\/([^\/]+)$/$1/;
            my $b;

            ($_=$addrs[$addr_ind]),($b= u64_from_hex($_)), (u64_bacmp($eaddr,$b) >=0) ;

            for(;($_=$addrs[$addr_ind]),($b= u64_from_hex($_)), ($addr_ind<=$#addrs) && (u64_bacmp($eaddr,$b)>=0) ; $addr_ind++)
            {
        #unknown:
                if(not defined $a2f{$_}) {
                    my $addr = $_;
                    $addr =~ s/^0+/0/;
                    $a2o{$_}=$basename;
                    $a2oa{$_}="0x".$addr; # save absolute address
                    $a2f{$_}="_".$basename."_$addr";  #TODO add basename of obj??
                    $f2a{$a2f{$_}}=$_;
                    $a2l{$_}=0; # not present
                }
            } 
        }
    }
}

# convert stacks to function-function and function-address events count; no separation of callers
# FIXME: function pairs are used; callgrind has support of deeper backtraces (separate-callers, Avoiding cycles; --separate-callers=N)
# FIXME: - it uses funct1'caller0'caller1 ... format to record separate callers
# in: %stacks, %a2f
# out: %fself, %functs, %total, %fcalls
sub stacks_to_pairs_and_count() {
    # For every event type (dprof can output several events at once)
    for my $event(keys %stacks){
      # iterate over all backtraces of current event @{stacks[$event]}
      for my $addr_line(keys %{$stacks{$event}}){
        my $i;
        my @addrs = split(/\s+/, $addr_line); 
        my $count = $stacks{$event}{$addr_line};

        # Update counters: 
        #  For top function (using address-to-function lookup) and instruction address:
        $fself{$a2f{$addrs[0]}}{$addrs[0]}{$event}+=$count;
        #  Mark function name as used (mark for output):
        $functs{$a2f{$addrs[0]}}++;
        #  Total event counter for current event
        $total{$event}+=$count;
        # Cycle over backtrace line (callstack)
        for($i=1;$i<=$#addrs;$i++){
           # Update callgraph pair: $fcalls{current_f}{child_f}[event_id] ++
           #  current function (lookup from current addr $stacks[$event][$s][$i] via addr2func)
           #  child function (lookup from addr $stacks[$event][$s][$i-1] via addr2func)
           $fcalls{$a2f{$addrs[$i]}}{$addrs[$i]}{$a2f{$addrs[$i-1]}}{$event}+=$count; 
           # Mark current function for output
           $functs{$a2f{$addrs[$i]}}++;
        }
      }
    }
}

# Reformat events hash \%ev; $ev{@events[$i]}= to string of numbers
# in: @events
sub events_h_to_str($) {
    my $ev_h_ref = shift;
    my %ev_h = %{$ev_h_ref};
    my $event;
    my $out="";
    # Iterate over all possible events
    for$event(0..$#events){
        # Event was fired for this instruction
        if(defined $ev_h{$events[$event]}) {
            $out .= " ".$ev_h{$events[$event]};
        } else {
        # This event was not fired for current instruction; output 0
            $out .= " 0";
        }
    }
    return $out;
}

# Name compression (functions), according to callgrind/cachegrind/kcachegrind file format
# Represent each function name as number; for first time output name-number pair
# Required for newer versions of Kcachegrind/qcachegring
#? convert to compr(object,fname) ?
# global: %f_compr, $compr_id
sub compr($) {
    my $fn = shift;
# to disable comression
#    return $fn;

    if(defined $f_compr{$fn}) {
        # Number is defined for this function name
        return $f_compr{$fn};
    } else {
        # This name is new; define name->number translation: name(number)
        $compr_id++;
        $f_compr{$fn} = "(".$compr_id.")";
        return $f_compr{$fn}." $fn";
    }
}

# Create file with callgrind/kcachegrind format
# in: 
#  [header] %total, %total_i, (@events), $dprof_out, $pid
#  [self] %functs, %a2o, %f2a, (compr), %fself, %a2s, %a2oa, %a2l
#  [calls] %fcalls, %a2s, %f2a, %a2o, (compr), %a2oa, %a2l
# out: stdout
sub output() {
    my $f;
    my $prev_src="";
    my $prev_obj=-1;
    my $offset;

    # Show total numbers to user:
    print STDERR "Total events on input:  ", events_h_to_str(\%total_i), "\n";
    print STDERR "Total events on output: ", events_h_to_str(\%total),"\n";

    print <<EOF
version:1
creator: dprof2callgrind
pid: $pid
cmd: $prog_name
part: 1

EOF
;
    print "desc: $_: the $_ based on $dprof_out [$pid]\n" for @events;

    print "\npositions: instr line\n";

    # Event list
    print "events: ", join( " ",@events );
    print "\n";

    # Sum of all events
    print "summary: ", events_h_to_str(\%total);
    print "\n";

    print <<EOF

EOF
;
    # Generate section for every function which was visited during events/callstack walking
    for $f (sort keys %functs) {
        my $call_point;

        # Object (output only when current object is not same as previous)
        my $ob = $a2o{$f2a{$f}};
        if( $ob ne $prev_obj){
            $prev_obj=$ob;
            print "ob=".$ob."\n";
        }

        # Output fl=??? for callgrind_annotate in begining of the file
        if($prev_src eq ""){
            $prev_src = "???";
            print "fl=$prev_src\n";
        }

        # Function name (compress - required for newer kcachegrind/qcachegrind)
        print "fn=".compr($f)."\n";
        # Output self events for the function $f:
        for(sort keys %{$fself{$f}}){
            # Output source file name (if differs from previous)
            if(($a2s{$_} ne $prev_src)&&($a2s{$_} ne "")){
                $prev_src=$a2s{$_};
                print "fl=$prev_src\n";
            }
            # "address line events"
            print $a2oa{$_}." "; # translate absolute address to address inside binary using a2oa lookup table
            print $a2l{$_}.events_h_to_str($fself{$f}{$_})."\n";
        }
        # Output calls outgoing from current $f
        for$call_point(sort keys %{$fcalls{$f}}){ # f= caller_name;
          for(sort keys %{$fcalls{$f}{$call_point}}){ # $_ = fname of called
            
            my $cob; # called object
            # Cross-source_file call
            if( $a2s{$f2a{$_}} != $prev_src) {
                # called source file
                print "cfl=".$a2s{$f2a{$_}};
            }
            $cob = $a2o{$f2a{$_}};
            # Cross-object call
            if( $cob ne $prev_obj ) {
                print "cob=".print_obj($cob)."\n";
            }

            # called function; compressed name.
            # Warning: call count is not stored in dprof output, because dprof is sampling profiler and
            #  call count can be found only in instrumenting (like gprof) or virtualized profiler (like valgrind)
            print "cfn=".compr($_)."\n"."calls=1 "; # output single call

            # "address\n" of called function
            print $a2oa{$f2a{$_}},"\n"; # absolute address -> address inside binary
            # address of call site
            # "call_site line events"
            print $a2oa{$call_point};
            print  " ".$a2l{$call_point}.events_h_to_str($fcalls{$f}{$call_point}{$_})."\n";
          }
        }
        print "\n";

    }
}

# Main function. 
#  Read dprof output; 
#  sort; 
#  resolve via addr2line; 
#  break stacktraces to call pairs; 
#  output in callgrind/kcachegrind (qcachegrind) format with compression
sub main()
{
    # Check first option
    if($ARGV[0] =~ /^-/) { 
        my $opt = shift @ARGV;
        ($opt =~ /^-C/) && do { $addr2line_demangle = $opt };
        ($opt =~ /^--?[hH]/) && do { usage(); };
        ($opt =~ /^--?version/) && do { version(); };
    } 
    # Check, are there two or three arguments. Else print usage help and exit
    if(($#ARGV+1 != 2) && ($#ARGV+1 != 3)) { usage(); }

    # Profiled binary name
    $prog_name = $ARGV[0];
    # File name of dprof profile
    $dprof_out = $ARGV[1];

    if( ! -r $prog_name ) { print "Can't read ELF file: $prog_name"; usage();}
    if( ! -r $dprof_out ) { print "Can't read dprof output: $dprof_out"; usage();}

    # Detect cross/native based on CPU arch
    my $cpu = `uname -m`;
    chomp $cpu;
    if(($cpu eq "e2k")||($cpu eq "sparc")||($cpu eq "sparc64")) {
        # Looks like native run
        $target_binutils_prefix= "/usr/bin/";
        $ldis_driver= "/opt/mcst/bin/ldis";
    } elsif (($cpu =~ /i.86/)||($cpu =~ /x86_64/)) {
        # Started from x86 - assume cross-environment. Warning: all binaries are searched by full path as they were on e2k/e90
    # FIXME - change binutils prefix for extern cross-environment
    # TODO - sparc ???
    # Set $target_binutils_prefix to path to cross-enviroment; e.g. "/opt/e2k-cross/bin/e2k-linux-" for
    #  addr2line installed as /opt/e2k-cross/bin/e2k-linux-addr2line
        $target_binutils_prefix= "/home/cf/e2k/mcst.rel-i-1.binutils/e2k-generic-linux.cross/bin/e2k-linux-";
        $ldis_driver= "";
    } else {
        # non-i686 is not expected as valid cross-environment
        print STDERR "Unknown platform $cpu\n";
        exit;
    }
    if( ! -x $target_binutils_prefix."addr2line" ) {
        print STDERR "Can't find usable addr2line tools from binutils.\n";
        print STDERR $target_binutils_prefix."addr2line", " is not executable.\n";
        print STDERR "Mapping addresses to functions is unavailable without it.\n";
        print STDERR "Set correct target_binutils_prefix for current platform (uname -m): ", $cpu, "\n";
        exit;
    }

    # 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) {
        
        # 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();
        }
    }

    @events = sort keys %stacks;

########
    # Iterate over all backtraces and mark addresses as used (to be translated via addr2line)
    mark_used_addrs();

    # Sort all objects ranges (based on /proc/../maps dump)
    sort_objs();

    # Resolve addresses to functions; using addr2line from binutils (cross or native)
    addr_resolve_addr2line();
    #addr_resolve_ldis();

########
    # Split all backtrace lists to backtrace pair; Some information is lost here, but 
    #  this is a format of Kcachegrind's callgraph
    # Other possible way of working with backtraces - store them in google-perftools 
    #  or in perf (Linux) format. Both are capable of saving/rendering full callstacks.
    stacks_to_pairs_and_count();

    # Write to output file. Callgrind format is used.
    output();
}

# start a main() function
main();

# PATH varibale for kcachegrind to use e2k's objdump (broken; incompatible format of disasm):
# e2k-binutils is folder with cross objdump utility; but without e2k-linux- or e90-linux- prefix
# create this one using bash: for a in objdump addr2line ...etc; ln -s /..path_to_cross../bin/e2k-linux-$a e2k-binutils/$a; done
#  export PATH=/..path_to_cross_root/e2k-binutils/:/usr/X11R6/bin:/usr/kde/3.5/bin/:$PATH
