mirror of https://github.com/Cisco-Talos/clamav
You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
134 lines
3.4 KiB
134 lines
3.4 KiB
#!/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];
|
|
}
|
|
|