#!perl -w
use strict;

use IO::File;

my ($profdata, $info)= readprofiling(shift);
my ($addrmap, $symmap)= readmapfile(shift);

my $mapoffset= $info->{mleaveproc} - $symmap->{mcountleave};

printf(" %d overflows  %08lx%08lx calls  leave=%08lx [+%08lx] clocks=%08lx ticks=%d\n\n", 
    $info->{overflows}, 
    $info->{entriesH}, $info->{entriesL},
    $info->{mleaveproc}, $mapoffset,
    $info->{clocks}, $info->{ticks});

my %ftotal;

my %calltree;

print "  caller->function :    count     time |     subs\n";
for my $rec (sort { $a->{timeL} <=> $b->{timeL} } (@$profdata)) {

    printf("%08lx->%08lx : %08lx %08lx | %08lx   %s -> %s\n",
        $rec->{caller}, $rec->{function},
        $rec->{count}, $rec->{timeL}, $rec->{subsL},

        findfunction($rec->{caller}-$mapoffset, $addrmap),
        findfunction($rec->{function}-$mapoffset, $addrmap));

    my $basecaller= getBaseFunction($rec->{caller}-$mapoffset, $addrmap)+$mapoffset;
    my $basefunction= getBaseFunction($rec->{function}-$mapoffset, $addrmap)+$mapoffset;

    if (!exists $ftotal{$basefunction})
    {
        my $fstats= {
            function=>$basefunction,
            count=>$rec->{count}, timeL=>$rec->{timeL}, subsL=>$rec->{subsL},
            subtime=>0,
        };
        $ftotal{$basefunction}= $fstats;
    }
    else {
        my $fstats= $ftotal{$basefunction};
        $fstats->{count} += $rec->{count};
        $fstats->{timeL} += $rec->{timeL};
        $fstats->{subsL} += $rec->{subsL};
    }

    if (!exists $ftotal{$basecaller})
    {
        my $fstats= {
            function=>$basecaller,
            count=>0, timeL=>0, subsL=>0,
            subtime=>$rec->{timeL},
        };
        $ftotal{$basecaller}= $fstats;
    }
    else {
        my $fstats= $ftotal{$basecaller};
        $fstats->{subtime} += $rec->{timeL};
    }
}

my $maximum= findmax(\%ftotal);

print "\n\n", "-"x77, "\n\n";

# time = the nr of 3686400 Hz clock ticks.
# the assumption is that : T= A*subs + B*count
print "function :    count     time |     subs   pctm   p.call {   subtm pcthis }\n";
for my $rec (sort { $a->{timeL} <=> $b->{timeL} } (values %ftotal)) {

	# div($rec->{timeL}-2.5*$rec->{subsL}, $rec->{count})
	#     might be a better indicator of time spent, this substracts the time spent
	#     profiling.

    printf("%08lx : %08lx %08lx | %08lx %6.2f %8.2f { %08lx %6.2f } %s\n",
        $rec->{function},

        $rec->{count}, $rec->{timeL}, $rec->{subsL},
        percent($maximum->{timeL}, $rec->{timeL}),
        div($rec->{timeL}, $rec->{count}),

        $rec->{timeL}-$rec->{subtime},
	percent($maximum->{timeL}, $rec->{timeL}-$rec->{subtime}),

        findfunction($rec->{function}-$mapoffset, $addrmap) 
    );
}

exit(0);

sub div {
    my ($a, $b)= @_;
    return $b? $a/$b : -1;
}
sub percent {
    my ($a, $b)= @_;
    return $b/$a*100.0;
}
sub readprofiling {
    my ($filename)= @_;

    my $fh= IO::File->new($filename, "r");
    binmode($fh);

    my @sizes= readlongs($fh, 3);
    my @mcountdata= readlongs($fh, $sizes[0]/4-3);

    my %info= (
        overflows=> $mcountdata[2],
        entriesH=> $mcountdata[4],
        entriesL=> $mcountdata[5],
        mleaveproc=> $mcountdata[6],
        statentries=> $mcountdata[11],
        stackentries=> $mcountdata[12],
        ticks=> $mcountdata[13],
        clocks=> $mcountdata[14],
    );

    my @statrecs;

    for (my $stat_i= 0 ; $stat_i < $info{statentries} ; $stat_i++)
    {
        my $statrec;
        $fh->read($statrec, $sizes[1]);

        my @data= unpack("L*", $statrec);

        next if ($data[2] == 0);

        push(@statrecs, {
                count=>$data[1],
                caller=>$data[2],
                function=>$data[3],
                timeH=>$data[4],
                timeL=>$data[5],
                subsH=>$data[6],
                subsL=>$data[7],
            });
    }

    # followed by a 64K hashtable
    # followed by the stack.
    $fh->close();
    return (\@statrecs, \%info);
}
sub readlongs {
    my ($fh, $n)= @_;

    my $data;
    $fh->read($data, 4*$n);

    return unpack("L*", $data);
}

sub readmapfile {
    my ($filename)= @_;

    my $fh= IO::File->new($filename, "r");

    my $section="";

    my %addr2sym;
    my %sym2addr;

    while(<$fh>)
    {
        chomp;

        next if (/^$/);

        if (/Start\s+Length\s+Name\s+Class/i)
        {
            $section="segdefs";
        }
        elsif (/Address\s+Publics\sby\sValue\s+Rva.Base\s+Lib.Object/i)
        {
            $section="symbols";
        }
        elsif(/Static\ssymbols/i)
        {
            $section="staticsymbols";
        }
        elsif(/entry\spoint\sat\s+\w+/i)
        {
            $section="";
        }
        elsif ($section eq "symbols" && /^\s*(\w+):(\w+)\s+(\S+)\s+(\w+)\s+(\S+)/)
        {
            my ($segment, $offset, $symbol, $rvabase, $object)= (hex($1), hex($2), $3, hex($4), $5);

            $addr2sym{$rvabase}= $symbol;
            $sym2addr{$symbol}= $rvabase;
        }
    }
    $fh->close();
    return (\%addr2sym, \%sym2addr);
}

sub findfunction {
    my ($addr, $map)= @_;

    for (sort {$b <=> $a} keys %$map)
    {
        if ($addr == $_)
        {
            return $map->{$_};
        }
        elsif ($addr > $_)
        {
            return sprintf("%s+%04x", $map->{$_}, $addr-$_);
        }
    }
    return "?";
}
sub getBaseFunction {
    my ($addr, $map)= @_;

    for (sort {$b <=> $a} keys %$map)
    {
        if ($addr >= $_)
        {
            return $_;
        }
    }
    return undef;
}
sub findmax {
    my ($stats)= @_;

    my $max;
    for (keys %$stats) {
        if (!defined $max || $stats->{$_}{timeL} > $max->{timeL}) {
            $max= $stats->{$_};
        }
    }

    return $max;
}