Skip to content
Snippets Groups Projects
Commit 4f1b4ae2 authored by Martin Mareš's avatar Martin Mareš
Browse files

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
No related branches found
No related tags found
No related merge requests found
Show whitespace changes
Inline Side-by-side
Showing
with 142 additions and 23 deletions
machinfo/machinfo
+ 142
− 23
View file @ 4f1b4ae2
#!/usr/bin/perl #!/usr/bin/perl
# A simple script to show processors, cores and NUMA nodes # 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 strict;
use warnings; use warnings;
use List::Util;
my $debug = 0; my $debug = 0;
our $sys = "/sys/devices/system"; our $sys = "/sys/devices/system";
our $spath; our $spath;
sub map_parse($) { sub set_from_map($) {
my %set = (); my %set = ();
my $i = 0; my $i = 0;
my $fw = 32; my $fw = 32;
...@@ -39,6 +40,18 @@ sub set_empty($) { ...@@ -39,6 +40,18 @@ sub set_empty($) {
return !keys %{$_[0]}; 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($$) { sub rd($$) {
open X, $spath . "/" . $_[0] or return $_[1]; open X, $spath . "/" . $_[0] or return $_[1];
my $x = <X>; my $x = <X>;
...@@ -47,9 +60,9 @@ sub rd($$) { ...@@ -47,9 +60,9 @@ sub rd($$) {
return $x; return $x;
} }
# Scan CPUs and their caches
my %cpu = (); my %cpu = ();
my %cache = (); my %cache = ();
my %levels = ();
my %cpu_ids = (); my %cpu_ids = ();
for my $c (<$sys/cpu/cpu[0-9]*>) { for my $c (<$sys/cpu/cpu[0-9]*>) {
$spath = "$c/topology"; $spath = "$c/topology";
...@@ -57,20 +70,21 @@ for my $c (<$sys/cpu/cpu[0-9]*>) { ...@@ -57,20 +70,21 @@ for my $c (<$sys/cpu/cpu[0-9]*>) {
my $p = rd("physical_package_id", 0); my $p = rd("physical_package_id", 0);
my $cr = rd("core_id", 0); my $cr = rd("core_id", 0);
$cpu{$p}{$cr}{$id} = 1; $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; print "CPU: $p/$cr/$id\n" if $debug;
for my $x (<$c/cache/index[0-9]*>) { for my $x (<$c/cache/index[0-9]*>) {
$spath = $x; $spath = $x;
my $l = rd("level", "?"); my $l = rd("level", "?");
my $m = map_parse(rd("shared_cpu_map", "")); my $m = set_from_map(rd("shared_cpu_map", ""));
$m->{$id} = 1; $m->{$id} = 1;
my $t = rd("type", "?"); my $t = rd("type", "?");
$t =~ s/(.).*/$1/; $t =~ s/(.).*/$1/;
$l = "L$l$t"; $l = "L$l$t";
print "\t$l cpus=", set_format($m), "\n" if $debug; my $name = set_format($m);
$levels{$l} = 1; print "\t$l cpus=$name\n" if $debug;
$cache{set_format($m)}{$l} = { $cache{$l}{$name} //= {
"cpus" => $m,
"level" => $l, "level" => $l,
"line" => rd("coherency_line_size", "?"), "line" => rd("coherency_line_size", "?"),
"size" => rd("size", "?"), "size" => rd("size", "?"),
...@@ -78,13 +92,15 @@ for my $c (<$sys/cpu/cpu[0-9]*>) { ...@@ -78,13 +92,15 @@ for my $c (<$sys/cpu/cpu[0-9]*>) {
}; };
} }
} }
my @levels = sort keys %cache;
# Scan NUMA nodes
my %nodes = (); my %nodes = ();
my %node_mem = (); my %node_mem = ();
for my $n (</$sys/node/node[0-9]*>) { for my $n (</$sys/node/node[0-9]*>) {
$spath = $n; $spath = $n;
my ($id) = ($n =~ /node(\d+)$/) or die; my ($id) = ($n =~ /node(\d+)$/) or die;
my $c = map_parse(rd("cpumap", "")); my $c = set_from_map(rd("cpumap", ""));
my $mem = "?"; my $mem = "?";
if (open my $x, "$spath/meminfo") { if (open my $x, "$spath/meminfo") {
while (<$x>) { while (<$x>) {
...@@ -95,6 +111,83 @@ for my $n (</$sys/node/node[0-9]*>) { ...@@ -95,6 +111,83 @@ for my $n (</$sys/node/node[0-9]*>) {
print "NODE $id: ", set_format($c), " ($mem)\n" if $debug; print "NODE $id: ", set_format($c), " ($mem)\n" if $debug;
$nodes{$id} = $c; $nodes{$id} = $c;
$node_mem{$id} = $mem; $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($$) { sub prcpu($$) {
...@@ -108,9 +201,9 @@ sub prcpu($$) { ...@@ -108,9 +201,9 @@ sub prcpu($$) {
} }
printf(" %-20s", $desc); printf(" %-20s", $desc);
my $fset = set_format($set); my $fset = set_format($set);
for my $l (sort keys %levels) { for my $l (@levels) {
my $c; my $c;
if ($c = $cache{$fset}{$l}) { if ($c = $cache{$l}{$fset}) {
printf " %-20s", $l . " (" . $c->{'size'} . "/" . $c->{'ways'} . "-way)"; printf " %-20s", $l . " (" . $c->{'size'} . "/" . $c->{'ways'} . "-way)";
} else { } else {
printf " %-20s", ""; printf " %-20s", "";
...@@ -119,17 +212,8 @@ sub prcpu($$) { ...@@ -119,17 +212,8 @@ sub prcpu($$) {
print "\n"; print "\n";
} }
sub prcpus($) { sub prcores($$) {
my ($id_set) = @_; my ($pkg, $id_set) = @_;
for my $pkg (sort { $a <=> $b } keys %cpu) {
my $pm = {};
for my $core (keys %{$cpu{$pkg}}) {
for my $id (keys %{$cpu{$pkg}{$core}}) {
$pm->{$id} = 1 if $id_set->{$id};
}
}
prcpu("CPU $pkg", $pm);
next if scalar keys %$pm <= 1;
for my $core (sort { $a <=> $b } keys %{$cpu{$pkg}}) { for my $core (sort { $a <=> $b } keys %{$cpu{$pkg}}) {
my $cm = set_intersect($cpu{$pkg}{$core}, $id_set); my $cm = set_intersect($cpu{$pkg}{$core}, $id_set);
prcpu(" Core $core", $cm); prcpu(" Core $core", $cm);
...@@ -142,6 +226,41 @@ sub prcpus($) { ...@@ -142,6 +226,41 @@ sub prcpus($) {
} }
} }
} }
sub prcpus($) {
my ($id_set) = @_;
for my $pkg (sort { $a <=> $b } keys %cpu) {
my $cpuids_in_pkg = {};
for my $core (keys %{$cpu{$pkg}}) {
for my $id (keys %{$cpu{$pkg}{$core}}) {
$cpuids_in_pkg->{$id} = 1;
}
}
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;
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);
}
}
} }
my $num_nodes = 0; my $num_nodes = 0;
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment