Import utilit z meho soukromeho repozitare

access/parse_op

+#!/usr/bin/perl
+# Parse XML output of opreport
+
+use strict;
+use warnings;
+
+use XML::Simple;
+# use Data::Dumper;
+
+my $x = XMLin($ARGV[0], ForceArray => 1);
+
+# print STDERR Dumper($x);
+
+my $events = $x->{'setup'}->[0]->{'eventsetup'};
+my $classes = $x->{'classes'}->[0]->{'class'};
+my %class_to_event;
+for my $c (keys %$classes) {
+	my $d = $classes->{$c};
+	my $e = $events->{$d->{'event'}}->{'eventname'};
+	# print "$c: $e\n";
+	$class_to_event{$c} = $e;
+}
+
+my $bin = $x->{'binary'};
+my $thisbin = (values %{$bin})[0];
+for my $c (@{$thisbin->{'count'}}) {
+	# print Dumper($c);
+	if (ref($c) eq "HASH") {
+		print $class_to_event{$c->{'class'}}, " ", $c->{'content'}+0, "\n";
+	} else {
+		print $events->{0}->{'eventname'}, " ", $c+0, "\n";
+	}
+}

machinfo/machinfo

+#!/usr/bin/perl
+# A simple script to show processors, cores and NUMA nodes
+# (c) 2010 Martin Mares <mj@ucw.cz>
+
+use strict;
+use warnings;
+
+my $debug = 0;
+
+our $sys = "/sys/devices/system";
+our $spath;
+
+sub map_parse($) {
+	my %set = ();
+	my $i = 0;
+	my $fw = 32;
+	for (reverse split /,/, $_[0]) {
+		for my $j (0..($fw-1)) {
+			if ((hex $_) & (1<<$j)) {
+				$set{$i * $fw + $j} = 1;
+			}
+		}
+	} continue {
+		$i++;
+	}
+	return \%set;
+}
+
+sub set_format($) {
+	return join(",", sort { $a <=> $b } keys %{$_[0]});
+}
+
+sub set_intersect($$) {
+	my ($a, $b) = @_;
+	return { map { $b->{$_} ? ($_ => 1) : () } keys %$a };
+}
+
+sub set_empty($) {
+	return !keys %{$_[0]};
+}
+
+sub rd($$) {
+	open X, $spath . "/" . $_[0] or return $_[1];
+	my $x = <X>;
+	chomp $x;
+	close X;
+	return $x;
+}
+
+my %cpu = ();
+my %cache = ();
+my %levels = ();
+my %cpu_ids = ();
+for my $c (<$sys/cpu/cpu[0-9]*>) {
+	$spath = "$c/topology";
+	my ($id) = ($c =~ /cpu(\d+)$/) or die;
+	my $p = rd("physical_package_id", 0);
+	my $cr = rd("core_id", 0);
+	$cpu{$p}{$cr}{$id} = 1;
+	$cpu_ids{$id} = "$p/$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", ""));
+		$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} = {
+			"level" => $l,
+			"line" => rd("coherency_line_size", "?"),
+			"size" => rd("size", "?"),
+			"ways" => rd("ways_of_associativity", "?"),
+		};
+	}
+}
+
+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 $mem = "?";
+	if (open my $x, "$spath/meminfo") {
+		while (<$x>) {
+			/^Node \d+ MemTotal:\s*(.*)/ and $mem = $1;
+		}
+		close $x;
+	}
+	print "NODE $id: ", set_format($c), " ($mem)\n" if $debug;
+	$nodes{$id} = $c;
+	$node_mem{$id} = $mem;
+}
+
+sub prcpu($$) {
+	my ($desc, $set) = @_;
+	if (scalar keys %$set == 0) {
+		return;
+	} elsif (scalar keys %$set == 1) {
+		printf "%2d", (keys %$set)[0];
+	} else {
+		print "  ";
+	}
+	printf("  %-20s", $desc);
+	my $fset = set_format($set);
+	for my $l (sort keys %levels) {
+		my $c;
+		if ($c = $cache{$fset}{$l}) {
+			printf " %-20s", $l . " (" . $c->{'size'} . "/" . $c->{'ways'} . "-way)";
+		} else {
+			printf " %-20s", "";
+		}
+	}
+	print "\n";
+}
+
+sub prcpus($) {
+	my ($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}}) {
+			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});
+				}
+			}
+		}
+	}
+}
+
+my $num_nodes = 0;
+for my $n (sort { $a <=> $b } keys %nodes) {
+	if (!set_empty($nodes{$n})) {
+		print "=== NODE $n (", $node_mem{$n}, ") ===\n";
+		$num_nodes++;
+		prcpus($nodes{$n});
+	}
+}
+
+if (!$num_nodes) {
+	prcpus(\%cpu_ids);
+}