#!/usr/bin/perl

# split_coverage.pl - split coverage information from Xen
#
# Copyright (C) 2013  - Citrix Systems
# -----
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.

use strict;
use File::Path qw(make_path);

my $fn = $ARGV[0];
open(IN, '<', $fn) or die 'opening';
my $data;
die 'reading' if !defined(sysread(IN, $data, 16*1024*1024));
my $s;
die 'reading' if sysread(IN, $s, 1) != 0;
close(IN);

my $pos = 0;

sub getRaw($)
{
    my $l = shift;
    die if $l < 0;
    die if $pos + $l > length($data);
    my $res = substr($data, $pos, $l);
    $pos += $l;
    return $res;
}

sub get32()
{
    return unpack('V', getRaw(4));
}

sub get64()
{
    return unpack('Q<', getRaw(8));
}

sub getS()
{
    my $l = get32();
    my $res = getRaw($l);
    $l = $l & 3;
    getRaw(4-$l) if $l;
    return $res;
}

sub peek32()
{
    my $res = get32();
    $pos -= 4;
    return $res;
}

my $magic = 0x67636461;
my $ctrBase = 0x01a10000;

die 'no coverage' if peek32() != 0x67636461;

sub parseFunctions($)
{
    my $numCounters = shift;
    my $tag = get32();
    my $num = get32();

    my @funcs;
    for my $n (1..$num) {
        my @data;
        my $ident = get32();
        my $checksum = get32();
        for my $n (1..$numCounters) {
            push @data, get32(); # number of counters for a type
        }
        push @funcs, [$ident, $checksum, \@data];
    }
    return @funcs;
}

sub parseCounters()
{
    my $numCounters = shift;
    my $tag = get32();
    die sprintf("wrong tag 0x%08x pos $pos (0x%08x)", $tag, $pos) if $tag < $ctrBase;
    $tag -= $ctrBase;
    die 'wrong tag' if $tag & 0x1ffff;
    $tag >>= 17;
    die 'wrong tag' if $tag > 5;
    my $data = '';

    my $num = get32();
    for my $n (1..$num) {
        my $ctr = get64(); # counter
        $data .= pack('VV', $ctr & 0xffffffff, ($ctr >> 32) & 0xffffffff);
    }
    return [$tag, $data];
}


sub parseFile()
{
    my $tag = get32();
    my $ver = get32();
    my $stamp = get32();
    my $fn = getS();
    my $numCounters;

    print "got file $fn\n";
    die if $fn !~ m,^(/.*?)[^/]+\.gcda$,;
    make_path(".$1");
    open(OUT, '>', ".$fn") or die;

    print OUT pack('VVV', $tag, $ver, $stamp);

    # read counters of file
    my @ctrs;
    my @funcs;
    for (;;) {
        my $tag = peek32();
        last if ($tag == $magic || $tag == 0);
        if ($tag == 0x01000000) {
            die if scalar(@funcs);
            @funcs = parseFunctions(scalar(@ctrs));
            next;
        }

        # must be a counter
        push @ctrs, parseCounters();
        ++$numCounters;
    }

    # print all functions
    for my $f (@funcs) {
        # tag tag_len ident checksum
        print OUT pack('VVVV', 0x01000000, 2, $f->[0], $f->[1]);
        # all counts
        my $n = 0;
        for my $c (@{$f->[2]}) {
            my ($type, $data) = @{$ctrs[$n]};
            print OUT pack('VV', $ctrBase + 0x20000 * $type, $c*2);
            die "--$c--$type--$data--" if length($data) < $c * 8;
            print OUT substr($data, 0, $c * 8);
            $ctrs[$n] = [$type, substr($data, $c * 8)];
            ++$n;
        }
    }
    close(OUT);
}

for (;;) {
    my $tag = peek32();
    if ($tag == $magic) {
        parseFile();
    } elsif ($tag == 0) {
        last;
    } else {
        die "wrong tag $tag";
    }
}