@@ -3,28 +3,41 @@

 use strict;

 use warnings;

-# usage poolsize.pl < mpool_spamfile

+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, ''] unless defined $sizes{$ptrs{$1}};

+	$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}}[0]++;

+	$sizes{$ptrs{$1}}[TEMP]++;

+	$maxes{$ptrs{$1}}[0]--;

 	delete $ptrs{$1};

 	next;

     }

@@ -37,10 +50,13 @@ while(<>) {

 }

 $overhead *= $sizeof_void_ptr;

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

-foreach (keys %ptrs) {

-    $sizes{$ptrs{$_}}[1]++;

-}

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

+undef %ptrs;

+

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

+undef %maxes;

 $maxsz |= $maxsz>>16;

 $maxsz |= $maxsz>>8;

@@ -50,31 +66,69 @@ $maxsz |= $maxsz>>1;

 $maxsz++;

 while($maxsz) {

+    my $nextsz = $maxsz>>1;

     if(defined $sizes{$maxsz}) {

-	$sizes{$maxsz}[2] = 'POW2';

+	$sizes{$maxsz}[REAS] = 'POW2';

     } else {

-	$sizes{$maxsz} = [0, 0, 'POW2'];

+	$sizes{$maxsz} = [0, 0, 0, 'POW2'];

     }

-    $maxsz>>=1;

-}

-

-my $grp_size = 0;

-foreach (sort { $b <=> $a } keys %sizes) {

-    my $count = $sizes{$_}[1];

-    my $score = ($grp_size - $_) * $count - $overhead;

-    $score = 0 unless $grp_size != 0;

+    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;

-    if($score >= 0 || $sizes{$_}[2] eq 'POW2') {

-	$grp_size = $_;

-	if($score >=0) {

-	    $sizes{$_}[2] = $sizes{$_}[2] eq 'POW2' ? 'USE/POW2' : 'USE';

+	    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);

+	    }

 	}

-    } else {

-	$sizes{$_}[2] = 'GROUP';

+	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    ACT! */\n";

+print "/* SIZE        PERM    TEMP     MAX    ACT! */\n";

 foreach (sort { $a <=> $b } keys %sizes) {

-    printf "%7u, /* %7u %7u %8s */\n", $_, $sizes{$_}[1], $sizes{$_}[0], $sizes{$_}[2];

+    printf "%7u, /* %7u %7u %7u %8s */\n", $_, $sizes{$_}[PERM], $sizes{$_}[TEMP], $sizes{$_}[MAXA], $sizes{$_}[REAS];

 }