#!/usr/bin/perl

use strict;
use warnings;

use constant PERM => 0;
use constant TEMP => 1;
use constant MAXA => 2;
use constant REAS => 3;

use constant TAKE => PERM;

# usage poolsize.pl < mpool_allocfile

my $sizeof_void_ptr;
my $overhead = 0;

my %ptrs;
my %sizes;
my %maxes;

my $maxsz = 0;

print STDERR "Parsing allocations...\n";
while(<>) {
    if(/malloc @(0x[0-9a-z]+) size (\d+) \((.*)\)/) {
	die "ptr $1 re-malloc" if defined $ptrs{$1};
	$ptrs{$1} = $2;
	$sizes{$ptrs{$1}} = [0, 0, 0, 'UNUSED'] unless defined $sizes{$ptrs{$1}};
	$maxes{$ptrs{$1}} = [0, 0] unless defined $maxes{$ptrs{$1}};
	$maxes{$ptrs{$1}}[0]++;
	$maxes{$ptrs{$1}}[1] = $maxes{$ptrs{$1}}[0] unless $maxes{$ptrs{$1}}[1] >= $maxes{$ptrs{$1}}[0];
	$maxsz = $2 unless $maxsz >= $2;
	$overhead++ if $3 eq 'new map';
	next;
    }
    if(/free @(0x[0-9a-z]+)/) {
	die "ptr $1 invalid free" unless defined $ptrs{$1};
	$sizes{$ptrs{$1}}[TEMP]++;
	$maxes{$ptrs{$1}}[0]--;
	delete $ptrs{$1};
	next;
    }
    if(/Map created @.*voidptr=(\d+)/) {
	$sizeof_void_ptr = $1;
	next;
    }
    chomp;
    print STDERR "warning bogus line:\n$_\n";
}

$overhead *= $sizeof_void_ptr;
print STDERR "Parsing complete (size overhead = $overhead)\n";

$sizes{$ptrs{$_}}[PERM]++ foreach (keys %ptrs);
undef %ptrs;

$sizes{$_}[MAXA] = $maxes{$_}[1] foreach (keys %maxes);
undef %maxes;

$maxsz |= $maxsz>>16;
$maxsz |= $maxsz>>8;
$maxsz |= $maxsz>>4;
$maxsz |= $maxsz>>2;
$maxsz |= $maxsz>>1;
$maxsz++;

while($maxsz) {
    my $nextsz = $maxsz>>1;
    if(defined $sizes{$maxsz}) {
	$sizes{$maxsz}[REAS] = 'POW2';
    } else {
	$sizes{$maxsz} = [0, 0, 0, 'POW2'];
    }
    my $nextpow2 = $nextsz;
    while(1) {
	my $refsz = $maxsz;
	my @group;
	foreach (sort { $b <=> $a } keys %sizes) {
	    next unless $_ > $nextpow2;
	    next unless $_ <= $maxsz;
	    next unless ($sizes{$_}[TAKE] > 0 || $_ == $maxsz);
	    $nextsz = $_;
	    last unless ($refsz - $_) * $sizes{$_}[TAKE] <= $overhead;
	    $refsz = $_;
	    push @group, $_;
	}
	while($#group >= 23) {
	    my $items = $#group / 2;
	    $nextsz = $group[$items + 1];
	    @group = @group[0..$items];
	}
	print STDERR "Processing group $maxsz -> $nextsz (count ".($#group + 1).")\n";
	my @topscore; # 0 => score | 1 => used bits | origbits
	for(my $origbits = 0; $origbits < 1<<$#group ; $origbits++) {
	    my $bits = $origbits;
	    my $bitcnt = 0;
	    my $score = $overhead;
	    my $grp_size = $maxsz;

	    printf STDERR "%3i%%\r", $origbits * 100 / (1<<$#group) unless ($origbits & 1);
	    for (my $i = 1; $i<= $#group; $i++) {
		if($bits & 1) {
		    $score +=  $overhead + $sizes{$group[$i]}[TAKE] * $group[$i];
		    $bitcnt++;
		    $grp_size = $group[$i];
		} else {
		    $score += $sizes{$group[$i]}[TAKE] * $grp_size;
		}
		$bits>>=1;
	    }
	    if(!defined $topscore[0] || $score < $topscore[0] || ($score == $topscore[0] && $bitcnt > $topscore[1])) {
		@topscore = ($score, $bitcnt, $origbits);
	    }
	}
	my $bits = ($topscore[2]<<1) | 1;
	for (my $i = 0; $i<=$#group; $i++) {
	    if ($bits & 1) {
		$sizes{$group[$i]}[REAS] = "USE";
	    } else {
		$sizes{$group[$i]}[REAS] = "GROUP";
	    }
	    $bits>>=1;
	}
	last unless $nextsz < $maxsz;
	$maxsz = $nextsz;
    }
    $maxsz = $nextpow2;
}

print "/* SIZE        PERM    TEMP     MAX    ACT! */\n";
foreach (sort { $a <=> $b } keys %sizes) {
    printf "%7u, /* %7u %7u %7u %8s */\n", $_, $sizes{$_}[PERM], $sizes{$_}[TEMP], $sizes{$_}[MAXA], $sizes{$_}[REAS];
}