Skip to content

Commit

Permalink
DNM! Analysis script for #634
Browse files Browse the repository at this point in the history
While working on #634, it's useful
to be able to simulate caching policies without having to write all the C++ to
actually run them.  Here's a terrible little Perl script that can probably do
most of what you might want.
  • Loading branch information
nwf-msr committed Dec 13, 2023
1 parent 2b14a78 commit 6f4097c
Showing 1 changed file with 177 additions and 0 deletions.
177 changes: 177 additions & 0 deletions src/test/perf/msgpass/remotecache-analyse.pl
Original file line number Diff line number Diff line change
@@ -0,0 +1,177 @@
#!/usr/bin/env perl

# This is not a place of honor. No highly esteemed deed is commemorated here.
# You'll definitely want to change which bits of this are commented out.

# A simplistic approximation of snmalloc caching and message passing. We
# assume that, once built, a message is not changed (e.g., not combined with
# others) until it is consumed by the recipient, regardless of however many
# hops it makes through the network. Thus, we need only track how many
# messages each source sends into the network.

# Assuming $LOG holds the stream of SNMALLOC_TRACING messages, you can use
# something like this to run this "simulator":
#
# pv $LOG | perl ./remotecache-analyse.pl | tail

use strict;
use English;

use Data::Dumper qw(Dumper);
$Data::Dumper::Terse = 1;
$Data::Dumper::Indent = 1;

use Hash::Util qw(hash_value);

my $total_messages = 0;
my $max_rings = 0;

# tid ->
# { messages => [[object]]
# , assembling => slab -> [object]
# , kv => 'a }
my $cache_by_tid = {};

sub slab_hash($) {
my ($slab) = @_;

# # Perl's built in hash function
# # If you're using this, probably also set PERL_HASH_SEED in the environment
# return hash_value($slab) & 0x3;

# # Sample some meaningful bits of allocator and slab
# return hex($slab) & 0x80040;

# # https://github.com/skeeto/hash-prospector
use integer;
my $slabh = hex($slab);
$slabh ^= $slabh >> 16;
$slabh = $slabh * 0x7feb352d;
$slabh ^= $slabh >> 15;
$slabh *= 0x846ca68b;
$slabh ^= $slabh >> 16;

# return $slabh & 0x0030_0000;
return $slabh & 0x3;
}

sub cache_evict($$$) {
my ($msgs, $cache, $key) = @_;

push @{$msgs}, $$cache{$key};
delete $$cache{$key};
}

sub cache_insert($$$) {
my ($tid, $slab, $obj) = @_;

if (not exists $$cache_by_tid{$tid}) { $$cache_by_tid{$tid} = { }; }
my $tc = $$cache_by_tid{$tid};

if (not exists $$tc{'messages'}) { $$tc{'messages'} = []; }
if (not exists $$tc{'assembling'}) { $$tc{'assembling'} = {}; }
if (not exists $$tc{'kv'}) { $$tc{'kv'} = {}; }

# No caching, just queue everything as a message
# {
# push @{$$tc{'messages'}}, $obj;
# return;
# }

# Otherwise, we maintain a set of "assembling" rings...
my $arings = $$tc{'assembling'};

# We can count how many rings we're tracking like this:
{
my $nrings = scalar keys %{$arings};
if ($nrings > $max_rings) { $max_rings = $nrings; }
}

# Direct-mapped cache using a hash of the slab
{
my $kv = $$tc{'kv'};
my $slabh = slab_hash($slab);
if (exists $$kv{$slabh} and $$kv{$slabh} ne $slab)
{
cache_evict($$tc{'messages'}, $arings, $slabh);
delete $$kv{$slabh};
}
if (not exists $$kv{$slabh})
{
$$kv{$slabh} = $slab;
$$arings{$slabh} = [ $obj ];
}
else
{
push @{$$arings{$slabh}}, $obj;
}
return;
}

# # Very primitive associative cache
# {
# if (exists $$arings{$slab})
# {
# push @{$$arings{$slab}}, $obj;
# }
# else
# {
# # # Eviction policy. If none, this will give "perfect" reassembly;
# # # otherwise, this implements full associtivity. Other strategies
# # # are perhaps sensible as well.
# # if (scalar keys %{$arings} >= 4)
# # {
# # my $key =
# # (sort
# # # { $a cmp $b } # address
# # { (scalar $$arings{$a}) <=> (scalar $$arings{$b})
# # || ($a cmp $b) } # size stabilized by address
# # (keys %{$arings}))[-1];
# # # print "Tid ", $tid, " evicting ", $key, " for ", $slab,
# # # " from ", (join ', ', sort keys %{$arings}), "\n";
# # cache_evict ($$tc{'messages'}, $arings, $key);
# # }
# $$arings{$slab} = [ $obj ];
# }
# return;
# }
}

sub cache_post($) {
my ($tid) = @_;

my $tc = $$cache_by_tid{$tid};

# Commit all assembling messages now
foreach my $aslab (keys %{$$tc{'assembling'}})
{
push @{$$tc{'messages'}}, $$tc{'assembling'}{$aslab};
}

my $messages = (scalar @{$$tc{'messages'}});
$total_messages += $messages;

# print "Post $tid ", $messages, "\n";
# delete $$tc{'assembling'}; # cosmetic improvement to printout
# print Dumper($$cache_by_tid{$tid});

delete $$cache_by_tid{$tid};
}

while (my $line = <>)
{
chomp $line;

if ($line =~ /(0x.*): Remote dealloc fast (0x.*) \(.*, (0x.*)\)/)
{
cache_insert($1, $3, $2);
}
elsif ($line =~ /(0x.*): Remote dealloc post (0x.*) \(.*, (0x.*)\)/)
{
cache_insert($1, $3, $2);
cache_post($1);
}
}

print "Max rings: $max_rings\n";
print "Total messages: $total_messages\n";

0 comments on commit 6f4097c

Please sign in to comment.