PSARC 2010/309 Processor Group (PG) Kstats and Tools

6923529 Provide command for printing PG utilization
6764835 Provide command for printing processor group information
6973973 Lonely Cache PG is created on M3000

2 files changed, 663 insertions, 0 deletions

diff --git a/usr/src/cmd/pginfo/Makefile b/usr/src/cmd/pginfo/Makefile
new file mode 100644
index 0000000000..c209c8f914
--- /dev/null
+++ b/usr/src/cmd/pginfo/Makefile
@@ -0,0 +1,45 @@
+#
+# CDDL HEADER START
+#
+# The contents of this file are subject to the terms of the
+# Common Development and Distribution License (the "License").
+# You may not use this file except in compliance with the License.
+#
+# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+# or http://www.opensolaris.org/os/licensing.
+# See the License for the specific language governing permissions
+# and limitations under the License.
+#
+# When distributing Covered Code, include this CDDL HEADER in each
+# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+# If applicable, add the following below this CDDL HEADER, with the
+# fields enclosed by brackets "[]" replaced with your own identifying
+# information: Portions Copyright [yyyy] [name of copyright owner]
+#
+# CDDL HEADER END
+#
+
+#
+# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved.
+#
+
+PROG=	pginfo
+
+include ../Makefile.cmd
+
+TARGET= all
+
+.KEEP_STATE:
+
+all: $(PROG)
+
+install: all .WAIT $(ROOTPROG)
+
+clean:
+
+$(ROOTBINPROG): $(PROG)
+	$(INS.file)
+
+lint:
+
+include ../Makefile.targ
diff --git a/usr/src/cmd/pginfo/pginfo.pl b/usr/src/cmd/pginfo/pginfo.pl
new file mode 100644
index 0000000000..8a15b4adc9
--- /dev/null
+++ b/usr/src/cmd/pginfo/pginfo.pl
@@ -0,0 +1,618 @@
+#! /usr/perl5/bin/perl
+#
+# CDDL HEADER START
+#
+# The contents of this file are subject to the terms of the
+# Common Development and Distribution License (the "License").
+# You may not use this file except in compliance with the License.
+#
+# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
+# or http://www.opensolaris.org/os/licensing.
+# See the License for the specific language governing permissions
+# and limitations under the License.
+#
+# When distributing Covered Code, include this CDDL HEADER in each
+# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
+# If applicable, add the following below this CDDL HEADER, with the
+# fields enclosed by brackets "[]" replaced with your own identifying
+# information: Portions Copyright [yyyy] [name of copyright owner]
+#
+# CDDL HEADER END
+#
+
+#
+# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved.
+#
+
+#
+# pginfo - tool for displaying Processor Group information
+#
+
+use warnings;
+use strict;
+use File::Basename;
+use Errno;
+use POSIX qw(locale_h);
+use Getopt::Long qw(:config no_ignore_case bundling auto_version);
+use List::Util qw(first max min);
+use Sun::Solaris::Utils qw(textdomain gettext);
+use Sun::Solaris::Pg;
+
+#
+# Constants
+#
+# It is possible that wnen trying to parse PG information, PG generation changes
+# which will cause PG new method to fail with errno set to EAGAIN In this case
+# we retry open up to RETRY_COUNT times pausing RETRY_DELAY seconds between each
+# retry.
+#
+# When printing PGs we print them as a little tree with each PG shifted by
+# LEVEL_OFFSET from each parent. For example:
+#
+# PG  RELATIONSHIP                    CPUs
+# 0   System                          0-7
+# 3    Socket                         0 2 4 6
+# 2     Cache                         0 2 4 6
+#
+
+use constant {
+	VERSION		=> 1.1,
+	LEVEL_OFFSET	=> 1,
+	RETRY_COUNT	=> 4,
+        RETRY_DELAY	=> 0.25,
+};
+
+#
+# Return codes
+#
+#     0    Successful completion.
+#
+#     1    An error occurred.
+#
+#     2    Invalid command-line options were specified.
+#
+use constant {
+	E_SUCCESS => 0,
+	E_ERROR => 1,
+	E_USAGE => 2,
+};
+
+
+# Set message locale
+setlocale(LC_ALL, "");
+textdomain(TEXT_DOMAIN);
+
+# Get script name for error messages
+our $cmdname = basename($0, ".pl");
+
+#
+# Process options
+#
+my $do_cpulist;			# -C - Show CPU IDs
+my $do_cpus;			# -c - Treat args as CPU IDs
+my $do_physical;		# -p - Show physical relationships
+my $do_sharing_only;		# -S - Only show sharing relationships
+my $do_tree;			# -T - Show ASCII tree
+my $do_usage;			# -h - Show usage
+my $do_version;			# -V - Show version
+my $script_mode;		# -I - Only show IDs
+my $verbose = 0;		# -v - Verbose output
+my @sharing_filter;		# -r string,...
+my @sharing_filter_neg;		# -R string,...
+
+# Exit code
+my $rc = E_SUCCESS;
+
+# Parse options from the command line
+GetOptions("cpus|c"		=> \$do_cpus,
+	   "idlist|I"		=> \$script_mode,
+	   "cpulist|C"		=> \$do_cpulist,
+	   "physical|p"		=> \$do_physical,
+	   "help|h|?"		=> \$do_usage,
+	   "sharing|s"		=> \$do_sharing_only,
+	   "relationship|r=s"	=> \@sharing_filter,
+	   "norelationship|R=s" => \@sharing_filter_neg,
+	   "tree|topology|T"	=> \$do_tree,
+	   "version|V"		=> \$do_version,
+	   "verbose+"		=> \$verbose,
+	   "v+"			=> \$verbose,
+) || usage(E_USAGE);
+
+# Print usage message when -h is given
+usage(E_SUCCESS) if $do_usage;
+
+if ($do_version) {
+	#
+	# Print version information and exit
+	#
+	printf gettext("%s version %s\n"), $cmdname, VERSION;
+	exit(E_SUCCESS);
+}
+
+#
+# Verify options compatibility
+#
+if ($script_mode && $do_cpulist) {
+	printf STDERR
+	  gettext("%s: options -I and -C can not be used at the same time\n"),
+	    $cmdname;
+	usage(E_USAGE);
+}
+
+if (($script_mode || $do_cpulist) &&
+    ($do_physical || $do_sharing_only ||
+    $do_tree)) {
+	printf STDERR
+	  gettext("%s: options -C and -I can not be used with -p -s or -T\n"),
+	    $cmdname;
+	usage(E_USAGE);
+}
+
+if ($do_physical && $do_sharing_only) {
+	printf STDERR
+	  gettext("%s: option -p can not be used with -s\n"), $cmdname;
+	usage(E_USAGE);
+}
+
+if ($do_tree && $do_sharing_only) {
+	printf STDERR
+	  gettext("%s: option -T can not be used with -s\n"),
+	    $cmdname;
+	usage(E_USAGE);
+}
+
+if ($verbose && !($script_mode || $do_cpulist || $do_sharing_only)) {
+	$do_tree = 1;
+	$do_physical = 1;
+}
+
+#
+# Get PG information
+#
+my $p = Sun::Solaris::Pg->new(-tags => $do_physical,
+			      -retry => RETRY_COUNT,
+			      '-delay' => RETRY_DELAY);
+
+if (!$p) {
+	printf STDERR
+	  gettext("%s: can not obtain Processor Group information: $!\n"),
+	    $cmdname;
+	exit(E_ERROR);
+}
+
+#
+# Convert -[Rr] string1,string2,... into list (string1, string2, ...)
+#
+@sharing_filter = map { split /,/ } @sharing_filter;
+@sharing_filter_neg = map { split /,/ } @sharing_filter_neg;
+
+#
+# Get list of all PGs in the system
+#
+my @all_pgs = $p->all_depth_first();
+
+if (scalar(@all_pgs) == 0) {
+	printf STDERR
+	  gettext("%s: this system does not have any Processor groups\n"),
+	    $cmdname;
+	exit(E_ERROR);
+}
+
+#
+# @pgs is the list of PGs we are going to work with after all the option
+# processing
+#
+my @pgs = @all_pgs;
+
+#
+# get list of all CPUs in the system by looking at the root PG cpus
+#
+my @all_cpus = $p->cpus($p->root());
+
+#
+# If there are arguments in the command line, treat them as either PG IDs or as
+# CPUs that should be converted to PG IDs.
+# Arguments can be specified as x-y x,y,z and use special keyword 'all'
+#
+if (scalar @ARGV) {
+	#
+	# Convert 'all' in arguments to all CPUs or all PGs
+	#
+	my @args;
+	my @all = $do_cpus ? @all_cpus : @all_pgs;
+	@args = map { $_ eq 'all' ? @all : $_ } @ARGV;
+
+	# Expand any x-y,z ranges
+	@args =  $p->expand(@args);
+
+	if ($do_cpus) {
+		# @bad_cpus is a list of invalid CPU IDs
+		my @bad_cpus =  $p->set_subtract(\@all_cpus, \@args);
+		if (scalar @bad_cpus) {
+			printf STDERR
+			  gettext("%s: Invalid processor IDs %s\n"),
+			    $cmdname, $p->id_collapse(@bad_cpus);
+			$rc = E_ERROR;
+		}
+		#
+		# List of PGs is the list of any PGs that contain specified CPUs
+		#
+		@pgs = grep {
+			my @cpus = $p->cpus($_);
+			scalar($p->intersect(\@cpus, \@args));
+		} @all_pgs;
+	} else {
+		# @pgs is a list of valid CPUs in the arguments
+		@pgs = $p->intersect(\@all_pgs, \@args);
+		# @bad_pgs is a list of invalid PG IDs
+		my @bad_pgs = $p->set_subtract(\@all_pgs, \@args);
+		if (scalar @bad_pgs) {
+			printf STDERR
+			  gettext("%s: Invalid PG IDs %s\n"),
+			    $cmdname, $p->id_collapse(@bad_pgs);
+			$rc = E_ERROR;
+		}
+	}
+}
+
+#
+# Now we have list of PGs to work with. Now apply filtering. First list only
+# those matching -R
+#
+@pgs = grep { list_match($p->sh_name($_), @sharing_filter) } @pgs if
+  scalar @sharing_filter;
+
+# Remove any that doesn't match -r
+@pgs = grep { !list_match($p->sh_name($_), @sharing_filter_neg) } @pgs if
+  scalar @sharing_filter_neg;
+
+# Do we have any PGs left?
+if (scalar(@pgs) == 0) {
+	printf STDERR
+	gettext("%s: no processor groups matching command line arguments %s\n"),
+	    $cmdname, "@ARGV";
+	exit(E_ERROR);
+}
+
+#
+# Global list of PGs that should be excluded from the output - it is only used
+# when tree mode is specified.
+#
+my @exclude_pgs;
+if ($do_tree) {
+	@exclude_pgs = grep {
+		list_match($p->sh_name($_), @sharing_filter_neg)
+	} @all_pgs;
+
+	#
+	# In tree mode add PGs that are in the lineage of given PGs
+	#
+	@pgs = pg_lineage($p, @pgs)
+}
+
+#
+# -I is specified, print list of all PGs
+#
+if ($script_mode) {
+	if (scalar(@pgs)) {
+		@pgs = sort { $a <=> $b } @pgs;
+		print "@pgs\n";
+	} else {
+		print "none\n";
+	}
+	exit($rc);
+}
+
+#
+# -C is specified, print list of all CPUs belonging to PGs
+#
+if ($do_cpulist) {
+	my @cpu_list = $p->uniqsort(map { $p->cpus($_) } @pgs);
+	print "@cpu_list\n";
+	exit($rc);
+}
+
+# Mapping of relationships to list of PGs
+my %pgs_by_relationship;
+
+# Maximum length of all sharing names
+my $max_sharename_len = length('RELATIONSHIP');
+
+# Maximum length of PG ID
+my $max_pg_len = length(max(@pgs)) + 1;
+
+#
+# For calculating proper offsets we need to know minimum and maximum level for
+# all PGs
+#
+my @levels = map { $p->level($_) } @pgs;
+my $maxlevel = max(@levels);
+my $minlevel = min(@levels);
+
+# Calculate maximum string length that should be used to represent PGs
+foreach my $pg (@pgs) {
+	my $name =  $p->sh_name ($pg) || "unknown";
+	my $level = $p->level($pg) || 0;
+
+	if ($do_physical) {
+		my $tags = $p->tags($pg);
+		$name = "$name [$tags]" if $tags;
+	}
+
+	my $length = length($name) + $level - $minlevel;
+	$max_sharename_len = $length if $length > $max_sharename_len;
+}
+
+if ($do_sharing_only) {
+	#
+	# -s - only print sharing relationships
+
+	# Get list of sharing relationships
+	my @relationships = $p->sharing_relationships(@pgs);
+
+	if ($verbose) {
+		printf "%-${max_sharename_len}s %s\n",
+		  'RELATIONSHIP', 'PGs';
+		foreach my $rel (@relationships) {
+			my @pg_rel = grep { $p->sh_name($_) eq $rel }
+			  @pgs;
+			my $pg_rel = $p->id_collapse (@pg_rel);
+			$pgs_by_relationship{$rel} = \@pg_rel;
+		}
+	}
+
+	foreach my $rel (@relationships) {
+		printf "%-${max_sharename_len}s", $rel;
+		if ($verbose) {
+			my @pgs = @{$pgs_by_relationship{$rel}};
+			my $pgs = $p->id_collapse (@pgs);
+			print ' ', $pgs;
+		}
+		print "\n";
+	}
+
+	# we are done
+	exit($rc);
+}
+
+#
+# Print PGs either in list form or tree form
+#
+if (!$do_tree) {
+	my $header;
+
+	$header = sprintf "%-${max_pg_len}s %-${max_sharename_len}s" .
+	  "   %s\n",
+	    'PG', 'RELATIONSHIP', 'CPUs';
+
+	print $header;
+	map { pg_print ($p, $_) } @pgs;
+} else {
+	#
+	# Construct a tree from PG hierarchy and prune any PGs that are
+	# specified with -R option
+	#
+	my $pg_tree = pg_make_tree($p);
+	map { pg_remove_from_tree($pg_tree, $_) } @exclude_pgs;
+
+	# Find top-level PGs
+	my @top_level = grep {
+		$pg_tree->{$_} && !defined($pg_tree->{$_}->{parent})
+	} @pgs;
+
+	# Print each top-level node as ASCII tree
+	foreach my $pg (@top_level) {
+		my $children = $pg_tree->{$pg}->{children};
+		my @children = $children ? @{$children} : ();
+		@children = $p->intersect(\@children, \@pgs);
+		pg_print_tree($p, $pg_tree, $pg, '', '', scalar @children);
+	}
+}
+
+# We are done!
+exit($rc);
+
+######################################################################
+# Internal functions
+#
+
+#
+# pg_print(cookie, pg)
+# print PG information in list mode
+#
+sub pg_print
+{
+	my $p = shift;
+	my $pg = shift;
+	my $sharing = $p->sh_name($pg);
+	if ($do_physical) {
+		my $tags = $p->tags($pg);
+		$sharing = "$sharing [$tags]" if $tags;
+	}
+	my $level = $p->level($pg) - $minlevel;
+	$sharing = (' ' x (LEVEL_OFFSET * $level)) . $sharing;
+	my $cpus = $p->cpus($pg);
+	printf "%-${max_pg_len}d %-${max_sharename_len}s", $pg, $sharing;
+	print "   $cpus";
+	print "\n";
+}
+
+#
+# pg_showcpus(cookie, pg)
+# Print CPUs in the current PG
+#
+sub pg_showcpus
+{
+	my $p = shift;
+	my $pg = shift;
+
+	my @cpus = $p->cpus($pg);
+	my $ncpus = scalar @cpus;
+	return 0 unless $ncpus;
+	my $cpu_string = $p->cpus($pg);
+	return (($ncpus == 1) ?
+		"CPU: $cpu_string":
+		"CPUs: $cpu_string");
+}
+
+#
+# pg_print_node(cookie, pg)
+# print PG as ASCII tree node
+#
+sub pg_print_node
+{
+	my $p = shift;
+	my $pg = shift;
+
+	my $sharing = $p->sh_name($pg);
+	if ($do_physical) {
+		my $tags = $p->tags($pg);
+		$sharing = "$sharing [$tags]" if $tags;
+	}
+
+	print "$pg ($sharing)";
+	my $cpus = pg_showcpus($p, $pg);
+	print " $cpus";
+	print "\n";
+}
+
+#
+# pg_print_tree(cookie, tree, pg, prefix, childprefix, npeers)
+# print ASCII tree of PGs in the tree
+# prefix should be used for the current node, childprefix for children nodes
+# npeers is the number of peers of the current node
+#
+sub pg_print_tree
+{
+	my $p = shift;
+	my $pg_tree = shift;
+	my $pg = shift;
+	return unless defined ($pg);	# done!
+	my $prefix = shift;
+	my $childprefix = shift;
+	my $npeers = shift;
+
+	# Get list of my children
+	my $children = $pg_tree->{$pg}->{children};
+	my @children = $children ? @{$children} : ();
+	@children = $p->intersect(\@children, \@pgs);
+	my $nchildren = scalar @children;
+
+	my $printprefix = "$childprefix";
+	my $printpostfix = $npeers ? "|   " : "    ";
+
+	my $bar = $npeers ? "|" : "`";
+
+	print $childprefix ? $childprefix : "";
+	print $prefix ? "$bar" . "-- " : "";
+	pg_print_node ($p, $pg);
+
+	my $new_prefix = $npeers ? $prefix : "    ";
+
+	# Print the subtree with a new offset, starting from each child
+	map {
+		pg_print_tree($p, $pg_tree, $_, "|   ",
+		      "$childprefix$new_prefix", --$nchildren)
+	} @children;
+}
+
+#
+# list_match(arg, list)
+# Return arg if argument matches any of the elements on the list
+#
+sub list_match
+{
+	my $arg = shift;
+
+	return first { $arg =~ m/$_/i } @_;
+}
+
+#
+# Make a version of PG parent-children relationships from cookie
+#
+sub pg_make_tree
+{
+	my $p = shift;
+	my $pg_tree = ();
+
+	foreach my $pg ($p->all()) {
+		my @children = $p->children($pg);
+		$pg_tree->{$pg}->{parent} = $p->parent($pg);
+		$pg_tree->{$pg}->{children} = \@children;
+	}
+
+	return ($pg_tree);
+}
+
+#
+# pg_remove_from_tree(tree, pg)
+# Prune PG from the tree
+#
+sub pg_remove_from_tree
+{
+	my $pg_tree = shift;
+	my $pg = shift;
+	my $node = $pg_tree->{$pg};
+	return unless $node;
+
+	my @children = @{$node->{children}};
+	my $parent = $node->{parent};
+	my $parent_node;
+
+	#
+	# Children have a new parent
+	#
+	map { $pg_tree->{$_}->{parent} = $parent } @children;
+
+	#
+	# All children move to the parent (if there is one)
+	#
+	if (defined($parent) && ($parent_node = $pg_tree->{$parent})) {
+		#
+		# Merge children from parent and @children list
+		#
+		my @parent_children = @{$parent_node->{children}};
+		#
+		# Remove myself from parent children
+		#
+		@parent_children = grep { $_ != $pg } @parent_children;
+		@parent_children = $p->nsort(@parent_children, @children);
+		$parent_node->{children} = \@parent_children;
+	}
+
+	# Remove current node
+	delete $pg_tree->{$pg};
+}
+
+#
+# For a given list of PGs return the full lineage
+#
+sub pg_lineage
+{
+	my $p = shift;
+	return unless scalar @_;
+
+	my @parents = grep { defined($_) } map { $p->parent ($_) } @_;
+
+	return ($p->uniq(@_, @parents, pg_lineage ($p, @parents)));
+}
+
+#
+# Print usage information and exit with the return code specified
+#
+sub usage
+{
+	my $rc = shift;
+	printf STDERR
+	  gettext("Usage:\t%s [-T] [-p] [-v] [-r string] [-R string] [pg ... | -c processor_id ...]\n\n"),
+	    $cmdname;
+	printf STDERR
+	  gettext("\t%s -s [-v] [-r string] [-R string] [pg ... | -c processor_id ...]\n\n"), $cmdname;
+	printf STDERR gettext("\t%s -C | -I [-r string] [-R string] [pg ... | -c processor_id ...]\n\n"),
+	  $cmdname;
+	printf STDERR gettext("\t%s -h\n\n"), $cmdname;
+
+	exit($rc);
+}
+
+__END__