Commit 4f1b4ae2 authored by Martin Mareš's avatar Martin Mareš

Machinfo si uz umi poradit s Bulldozerem

Logika detekce modulu je ponekud divoka, snazil jsem se, aby nebyla
specificka pro Bulldozer, ale zvladla i potencialni dalsi pripady
sloziteho sdileni cachi. Snad to nebude moc pomale.
parent 0ab195d9
#!/usr/bin/perl
# A simple script to show processors, cores and NUMA nodes
# (c) 2010 Martin Mares <mj@ucw.cz>
# (c) 2010--2014 Martin Mares <mj@ucw.cz>
use strict;
use warnings;
use List::Util;
my $debug = 0;
our $sys = "/sys/devices/system";
our $spath;
sub map_parse($) {
sub set_from_map($) {
my %set = ();
my $i = 0;
my $fw = 32;
......@@ -39,6 +40,18 @@ sub set_empty($) {
return !keys %{$_[0]};
}
sub set_contained_in($$) {
my ($small, $big) = @_;
for (keys %$small) {
$big->{$_} or return;
}
return 1;
}
sub sets_equal($$) {
return set_format($_[0]) eq set_format($_[1]);
}
sub rd($$) {
open X, $spath . "/" . $_[0] or return $_[1];
my $x = <X>;
......@@ -47,9 +60,9 @@ sub rd($$) {
return $x;
}
# Scan CPUs and their caches
my %cpu = ();
my %cache = ();
my %levels = ();
my %cpu_ids = ();
for my $c (<$sys/cpu/cpu[0-9]*>) {
$spath = "$c/topology";
......@@ -57,20 +70,21 @@ for my $c (<$sys/cpu/cpu[0-9]*>) {
my $p = rd("physical_package_id", 0);
my $cr = rd("core_id", 0);
$cpu{$p}{$cr}{$id} = 1;
$cpu_ids{$id} = "$p/$cr";
$cpu_ids{$id} = { phys_pkg => $p, core => $cr };
print "CPU: $p/$cr/$id\n" if $debug;
for my $x (<$c/cache/index[0-9]*>) {
$spath = $x;
my $l = rd("level", "?");
my $m = map_parse(rd("shared_cpu_map", ""));
my $m = set_from_map(rd("shared_cpu_map", ""));
$m->{$id} = 1;
my $t = rd("type", "?");
$t =~ s/(.).*/$1/;
$l = "L$l$t";
print "\t$l cpus=", set_format($m), "\n" if $debug;
$levels{$l} = 1;
$cache{set_format($m)}{$l} = {
my $name = set_format($m);
print "\t$l cpus=$name\n" if $debug;
$cache{$l}{$name} //= {
"cpus" => $m,
"level" => $l,
"line" => rd("coherency_line_size", "?"),
"size" => rd("size", "?"),
......@@ -78,13 +92,15 @@ for my $c (<$sys/cpu/cpu[0-9]*>) {
};
}
}
my @levels = sort keys %cache;
# Scan NUMA nodes
my %nodes = ();
my %node_mem = ();
for my $n (</$sys/node/node[0-9]*>) {
$spath = $n;
my ($id) = ($n =~ /node(\d+)$/) or die;
my $c = map_parse(rd("cpumap", ""));
my $c = set_from_map(rd("cpumap", ""));
my $mem = "?";
if (open my $x, "$spath/meminfo") {
while (<$x>) {
......@@ -95,6 +111,83 @@ for my $n (</$sys/node/node[0-9]*>) {
print "NODE $id: ", set_format($c), " ($mem)\n" if $debug;
$nodes{$id} = $c;
$node_mem{$id} = $mem;
for my $cpuid (keys %$c) { $cpu_ids{$cpuid}{'node'} = $id; }
}
# Identify internal subdivisions like Bulldozer modules
my %modules = ();
for my $l (@levels) {
CACHE: for my $c (values %{$cache{$l}}) {
my $cpus = $c->{cpus};
print "Cache $l ", set_format($cpus), "\n" if $debug;
my %pkg_ids = map { $cpu_ids{$_}{'phys_pkg'} => 1 } keys %{$cpus};
print "\tPackages: ", set_format(\%pkg_ids), "\n" if $debug;
if (keys %pkg_ids > 1) {
print "\tSpans multiple pkgs!\n" if $debug;
print STDERR "Warning: Cache spans multiple physical packages\n";
next CACHE;
}
my ($pkg_id) = keys %pkg_ids;
my $cpus_in_pkg = { map { %{$_} } values %{$cpu{$pkg_id}} };
print "\tCPUs in pkg: ", set_format($cpus_in_pkg), "\n" if $debug;
if (sets_equal($cpus_in_pkg, $cpus)) {
print "\tSpans whole package\n" if $debug;
next CACHE;
}
my $nodes_in_pkg = { map { $cpu_ids{$_}{'node'} => 1 } keys %$cpus_in_pkg };
my $cpus_in_subpkg = $cpus_in_pkg;
print "\tNodes in pkg: ", set_format($nodes_in_pkg), "\n" if $debug;
if (keys %$nodes_in_pkg > 1) {
# Check intersections of node with package
for my $node (keys %$nodes_in_pkg) {
$cpus_in_subpkg = set_intersect($cpus_in_pkg, $nodes{$node});
print "\tCPUs in sub-pkg for node $node: ", set_format($cpus_in_subpkg), "\n" if $debug;
next if set_empty(set_intersect($cpus, $cpus_in_subpkg));
if (!set_contained_in($cpus, $cpus_in_subpkg)) {
print "\tSpans multiple sub-pkgs!\n" if $debug;
print STDERR "Warning: Cache spans multiple physical sub-packages\n" if $debug;
next CACHE;
}
if (sets_equal($cpus_in_subpkg, $cpus)) {
print "\tSpans whole sub-pkg\n" if $debug;
next CACHE;
}
last;
}
}
print "\tCPUs in sub-pkg: ", set_format($cpus_in_subpkg), "\n" if $debug;
# Beware, core numbers are unique only within sub-package, but at this moment
# we have fixed the sub-package.
my $cores = { map { $cpu_ids{$_}{'core'} => 1 } keys %{$cpus} };
print "\tCores: ", set_format($cores), "\n" if $debug;
if (keys %$cores <= 1) {
print "\tSpans only one core\n" if $debug;
next CACHE;
}
# Check strange cases
my $cpus_in_cores = set_intersect($cpus_in_subpkg, { map { %{$cpu{$pkg_id}{$_}} } keys %$cores });
print "\tCPUs in cores: ", set_format($cpus_in_cores), "\n" if $debug;
if (!sets_equal($cpus, $cpus_in_cores)) {
print "\tSpans core boundaries!\n" if $debug;
print STDERR "Warning: Cache spans multiple partial cores\n";
next CACHE;
}
my $module_name = set_format($cpus);
print "\tGotcha! We have a module: $module_name\n" if $debug;
push @{$modules{$pkg_id}}, $cpus;
for my $id (keys %$cpus) {
$cpu_ids{$id}{'module'} //= $module_name;
if ($cpu_ids{$id}{'module'} ne $module_name) {
print STDERR "Warning: CPU $id belongs to different modules: ", $module_name, " and ", $cpu_ids{$id}{'module'}, "\n";
}
}
}
}
sub prcpu($$) {
......@@ -108,9 +201,9 @@ sub prcpu($$) {
}
printf(" %-20s", $desc);
my $fset = set_format($set);
for my $l (sort keys %levels) {
for my $l (@levels) {
my $c;
if ($c = $cache{$fset}{$l}) {
if ($c = $cache{$l}{$fset}) {
printf " %-20s", $l . " (" . $c->{'size'} . "/" . $c->{'ways'} . "-way)";
} else {
printf " %-20s", "";
......@@ -119,27 +212,53 @@ sub prcpu($$) {
print "\n";
}
sub prcores($$) {
my ($pkg, $id_set) = @_;
for my $core (sort { $a <=> $b } keys %{$cpu{$pkg}}) {
my $cm = set_intersect($cpu{$pkg}{$core}, $id_set);
prcpu(" Core $core", $cm);
if (scalar keys %$cm > 1) {
my $t = 0;
for my $id (sort { $a <=> $b } keys %$cm) {
$t++;
prcpu(" Thread $t", {$id=>1});
}
}
}
}
sub prcpus($) {
my ($id_set) = @_;
for my $pkg (sort { $a <=> $b } keys %cpu) {
my $pm = {};
my $cpuids_in_pkg = {};
for my $core (keys %{$cpu{$pkg}}) {
for my $id (keys %{$cpu{$pkg}{$core}}) {
$pm->{$id} = 1 if $id_set->{$id};
$cpuids_in_pkg->{$id} = 1;
}
}
prcpu("CPU $pkg", $pm);
my $pm = set_intersect($cpuids_in_pkg, $id_set);
my $name = "CPU $pkg";
if (set_format($pm) ne set_format($cpuids_in_pkg)) {
$name .= " (part)";
}
prcpu($name, $pm);
next if scalar keys %$pm <= 1;
for my $core (sort { $a <=> $b } keys %{$cpu{$pkg}}) {
my $cm = set_intersect($cpu{$pkg}{$core}, $id_set);
prcpu(" Core $core", $cm);
if (scalar keys %$cm > 1) {
my $t = 0;
for my $id (sort { $a <=> $b } keys %$cm) {
$t++;
prcpu(" Thread $t", {$id=>1});
}
if ($modules{$pkg}) {
my @m = @{$modules{$pkg}};
# Sort modules by their lowest CPU id
@m = map { $_->[0] } sort { $a->[1] <=> $b->[1] } map { [ $_, List::Util::min(keys %$_) ] } @m;
my $mi = 0;
for my $module (@m) {
my $mm = set_intersect($module, $pm);
next if set_empty($mm);
prcpu(" Module $mi", $mm);
prcores($pkg, $mm);
$mi++;
}
} else {
prcores($pkg, $id_set);
}
}
}
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment