swapout: Make it harder to compress memory.

This commit is contained in:
Ole Tange 2022-11-08 18:11:57 +01:00
parent 3cbcd97714
commit 860c780a78

View file

@ -2,6 +2,7 @@
use strict;
my $usegb = 1000*shift;
my $timeout = shift || 10;
my $giga = 2**30;
@ -9,7 +10,7 @@ my $forks = 1;
my $free;
my $memtotal = int(
my $memtotal = $usegb || int(
qx{ awk '/^(MemTotal):/ { sum += \$2} END { print sum }' /proc/meminfo }
/ 1024);
@ -17,27 +18,37 @@ my $total = 1;
# 1 MB random data so it is not compressed
my $onemb = pack("L*", map { rand(2**32) } 1..(2**18));
my ($missing, $sofar,$timediff, %buf, $pid,$shift);
my ($thisround, $sofar,$timediff, %buf, $pid,$shift);
do {
my $start = time;
$free = int (
qx{ awk '/^((Swap)?Cached|MemFree|Buffers):/ { sum += \$2} END { print sum }' /proc/meminfo }
/ 1024);
$free =
int (
qx{ awk '/^((Swap)?Cached|MemFree|Buffers):/ { sum += \$2} END { print sum }' /proc/meminfo }
/ 1024)
or
int (
qx{ awk '/^MemAvailable:/ { sum += \$2 } END { print sum }' /proc/meminfo }
/ 1024);
print "Free $free ";
if($free <= 1) {
print "\nFree < 1\n";
exit(1);
}
$total += int($free/100);
$missing = $total - $sofar;
for(1..$missing) {
# Use at most 1 GB per round
$thisround = min(1000,int($free/100));
$total += $thisround;
for(1..$thisround) {
# Shift every block 1 byte, so no blocks have the same content
$buf{$forks}{$total}{$_} = "x"x(++$shift) . $onemb;
if($shift > 4095) {
# If shifted a full page: Recompute 1mb random
$shift -= 4096;
$onemb = pack("L*", map { rand(2**32) } 1..(2**18));
}
}
$sofar = $total;
$timediff = time - $start;
print "Chunk size: $missing Time for swapping: $timediff seconds. Total memory used: $total\n";
print "Chunk size: $thisround Time for swapping: $timediff seconds. Total memory used: $total\n";
if($total * 1048576 > $forks * $giga) {
if($pid = fork()) {
print "child spawn ",$forks,"\n";
@ -50,3 +61,16 @@ do {
}
} until ($pid or $timediff > $timeout or $total > $memtotal);
print "exit ",$forks,"\n";
sub min {
# Returns:
# Minimum value of array
my $min;
for (@_) {
# Skip undefs
defined $_ or next;
defined $min or do { $min = $_; next; }; # Set $_ to the first non-undef
$min = ($min < $_) ? $min : $_;
}
return $min;
}