#
# Subroutines to parses a ghc Garbage Collection stats file
#
#%gcstats = &parse_stats($ARGV[0]);
#&print_stats(">-", %gcstats);
#exit 0;

sub to_num {
    local ($text) = @_;
    return($1 * 1000000000 + $2 * 1000000 + $3 * 1000 + $4)
	if ( $text =~ /^(\d*),(\d*),(\d*),(\d*)$/ );
    return($1 * 1000000 + $2 * 1000 + $3)
	if ( $text =~ /^(\d*),(\d*),(\d*)$/ );
    return($1 * 1000 + $2)
	if ( $text =~ /^(\d*),(\d*)$/ );
    return($1)
	if ( $text =~ /^(\d*)$/ );
    die "Error converting $text\n";
}

sub from_num {
    local ($num) = @_;
    local ($b, $m, $t, $o) = (int($num/1000000000), int($num/1000000)%1000,
	   		      int($num/1000)%1000, $num%1000);
    return(sprintf("%d,%03d,%03d,%03d", $b, $m, $t, $o)) if $b > 0;
    return(sprintf("%d,%03d,%03d", $m, $t, $o))		 if $m > 0;
    return(sprintf("%d,%03d", $t, $o)) 			 if $t > 0;
    return(sprintf("%d", $o)) 				 if $o > 0;
}

sub parse_stats {
    local($filename) = @_;
    local($tot_alloc, $tot_gc_user, $tot_mut_user, $tot_user,
		      $tot_gc_elap, $tot_mut_elap, $tot_elap);
    local($statsfile, $line, $row, $col, $val);
    local(@stats, @hdr1, @hdr2, @line_vals);
    local(%the_stats);
    local(*STATS);

    open(STATS, $filename) || die "Cant open $filename \n";
    @stats = <STATS>;

    do {$line = shift(@stats);} until ($line !~ /^$/);
    chop($line);
    ($the_stats{"command"}, $the_stats{"args"}) = split(' ', $line, 2);

    do {$line = shift(@stats);} until ($line !~ /^$/);
    $line =~ /Collector:\s*([A-Z]+)\s*HeapSize:\s*([\d,]+)/;
    $the_stats{"collector"} = $1;
    $the_stats{"heapsize"}  = &to_num($2);

    do {$line = shift(@stats);} until ($line !~ /^$/);
    chop($line);
    @hdr1 = split(' ', $line);
    $line = shift(@stats);
    chop($line);
    @hdr2 = split(' ', $line);

    $row = 0;
    $tot_alloc = 0;
    $tot_gc_user = 0; 
    $tot_gc_elap = 0; 
    $tot_mut_user = 0; 
    $tot_mut_elap = 0; 
    $tot_user = 0;
    $tot_elap = 0;

    while (($line = shift(@stats)) !~ /^\s*\d+\s*$/) {
	chop($line);
	@line_vals = split(' ', $line);

	$col = -1;
	word:
	    while(++$col <= $#line_vals) {
	
	    $val = $line_vals[$col];
	    $_ = @hdr1[$col] . @hdr2[$col];

	    /^Allocbytes$/      && do {	$tot_alloc += $val;
				   	$the_stats{"alloc_$row"} = $val;
				   	next word; };

	    /^Collectbytes$/	&& do {	$the_stats{"collect_$row"} = $val;
				   	next word; };

	    /^Livebytes$/	&& do {	$the_stats{"live_$row"} = $val;
				   	next word; };

	    /^Residency$/	&& do { next word; };

	    /^GCuser$/		&& do {	$tot_gc_user += $val;
					$the_stats{"gc_user_$row"} = $val;
				   	next word; };

	    /^GCelap$/		&& do {	$tot_gc_elap += $val;
					$the_stats{"gc_elap_$row"} = $val;
				   	next word; };

	    /^TOTuser$/		&& do {	$the_stats{"mut_user_$row"} =
						$val - $tot_user - $the_stats{"gc_user_$row"};
					$tot_mut_user += $the_stats{"mut_user_$row"};
					$tot_user = $val;
				   	next word; };

	    /^TOTelap$/		&& do {	$the_stats{"mut_elap_$row"} =
						$val - $tot_elap - $the_stats{"gc_elap_$row"};
					$tot_mut_elap += $the_stats{"mut_elap_$row"};
					$tot_elap = $val;
				   	next word; };

	    /^PageGC$/		&& do {	$the_stats{"gc_pflts_$row"} = $val;
				   	next word; };

	    /^FltsMUT$/		&& do {	$the_stats{"mut_pflts_$row"} = $val;
				   	next word; };

	    /^Collection/	&& do { $the_stats{"mode_$row"} = $val;
				   	next word; };

	    /^Astkbytes$/	&& do {next word; };
	    /^Bstkbytes$/	&& do {next word; };
	    /^CafNo$/		&& do {next word; };
	    /^Cafbytes$/	&& do {next word; };

	    /^NoAstk$/		&& do {next word; };
	    /^ofBstk$/		&& do {next word; };
	    /^RootsReg$/	&& do {next word; };
	    /^OldGen$/		&& do {next word; };
	    /^RootsCaf$/	&& do {next word; };
	    /^Sizebytes$/	&& do {next word; };
	    /^Resid\%heap$/	&& do {next word; };

            /^$/		&& do {next word; };

	    print STDERR "Unknown: $_ = $val\n";
	};

	$row++;
    };
    $tot_alloc += $line;
    $the_stats{"alloc_$row"} = $line;

arg: while($_ = $stats[0]) {
    shift(@stats);

    /^\s*([\d,]+) bytes alloc/	&& do { local($a) = &to_num($1);
					$a == $tot_alloc || die "Total $a != $tot_alloc \n";
					$the_stats{"alloc_total"} = $tot_alloc;
					next arg; };

    /^\s*([\d]+) garbage/   	&& do { $1 == $row || die "GCNo $1 != $row \n";
					$the_stats{"gc_no"} = $row;
					next arg; };

    /Total time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
					$the_stats{"user_total"} = $1;
					$the_stats{"elap_total"} = $2;
					$the_stats{"mut_user_total"} = $1 - $tot_gc_user;
					$the_stats{"mut_elap_total"} = $2 - $tot_gc_elap;
					$the_stats{"mut_user_$row"} = $1 - $tot_gc_user - $tot_mut_user;
					$the_stats{"mut_elap_$row"} = $2 - $tot_gc_elap - $tot_mut_elap;
					next arg; };

    /GC\s+time\s+([\d\.]+)s\s+\(\s*([\d.]+)s elapsed\)/ && do {
					# $1 == $tot_gc_user || die "GCuser $1 != $tot_gc_user \n";
					# $2 == $tot_gc_elap || die "GCelap $2 != $tot_gc_elap \n";
					$the_stats{"gc_user_total"} = $tot_gc_user;
					$the_stats{"gc_elap_total"} = $tot_gc_elap;
					next arg; };
    
    /MUT\s+time/		&& do { next arg; };
    /INIT\s+time/		&& do { next arg; };
    /^\s*([\d,]+) bytes maximum residency/ && do { next arg; };

    /\%GC time/			&& do { next arg; };
    /Alloc rate/		&& do { next arg; };
    /Productivity/		&& do { next arg; };
    /^$/			&& do { next arg; };
    /^\#/			&& do { next arg; };  # Allows comments to follow
    
    print STDERR "Unmatched line: $_";
    }

    close(STATS);
    %the_stats;
}

sub print_stats {
    local ($filename, %out_stats) = @_;
    local($statsfile, $row);

    open($statsfile, $filename) || die "Cant open $filename \n";
    select($statsfile);

    print $out_stats{"command"}, " ", $out_stats{"args"}, "\n\n";
    print "Collector: ", $out_stats{"collector"}, "  HeapSize: ", &from_num($out_stats{"heapsize"}), " (bytes)\n\n";

    $row = 0;
    while ($row < $out_stats{"gc_no"}) {
	printf  "%7d %7d %7d %5.2f %5.2f %5.2f %5.2f %4d %4d  %s\n",
		$out_stats{"alloc_$row"},
		$out_stats{"collect_$row"},
		$out_stats{"live_$row"},
		$out_stats{"gc_user_$row"},
		$out_stats{"gc_elap_$row"},
		$out_stats{"mut_user_$row"},
		$out_stats{"mut_elap_$row"},
		$out_stats{"gc_pflts_$row"},
		$out_stats{"mut_pflts_$row"},
		$out_stats{"mode_$row"};
	$row++;
    };
    printf "%7d %s %5.2f %5.2f \n\n",
   	   $out_stats{"alloc_$row"}, " " x 27,
	   $out_stats{"mut_user_$row"},
	   $out_stats{"mut_elap_$row"};

    printf "Total Alloc: %s\n", &from_num($out_stats{"alloc_total"});
    printf "      GC No: %d\n\n", $out_stats{"gc_no"};

    printf "  MUT User: %6.2fs\n", $out_stats{"mut_user_total"};
    printf "   GC User: %6.2fs\n", $out_stats{"gc_user_total"};
    printf "Total User: %6.2fs\n\n", $out_stats{"user_total"};

    printf "  MUT Elap: %6.2fs\n", $out_stats{"mut_elap_total"};
    printf "   GC Elap: %6.2fs\n", $out_stats{"gc_elap_total"};
    printf "Total Elap: %6.2fs\n", $out_stats{"elap_total"};

    close($statsfile);
}

1;