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

5 files changed, 1931 insertions, 6 deletions

diff --git a/usr/src/cmd/perl/5.8.4/contrib/Makefile b/usr/src/cmd/perl/5.8.4/contrib/Makefile
index 32aa28c230..61989e0193 100644
--- a/usr/src/cmd/perl/5.8.4/contrib/Makefile
+++ b/usr/src/cmd/perl/5.8.4/contrib/Makefile
@@ -18,11 +18,9 @@
 #
 # CDDL HEADER END
 #
+
 #
-# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
-# Use is subject to license terms.
-#
-#ident	"%Z%%M%	%I%	%E% SMI"
+# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved.
 #
 
 include ../../../Makefile.cmd
@@ -55,7 +53,9 @@ PERL_DYNAMIC_EXT = \
 # Add any pure-perl extensions here.
 PERL_NONXS_EXT = \
     $(SUN_SOLARIS)/BSM \
-    $(SUN_SOLARIS)/PerlGcc
+    $(SUN_SOLARIS)/PerlGcc \
+    $(SUN_SOLARIS)/Pg
+
 
 PERL_EXT = $(PERL_DYNAMIC_EXT) $(PERL_NONXS_EXT)
 PERL_EXT_MAKEFILES = $(PERL_EXT:%=%/Makefile)
diff --git a/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/Makefile.PL b/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/Makefile.PL
new file mode 100644
index 0000000000..f45d918f84
--- /dev/null
+++ b/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/Makefile.PL
@@ -0,0 +1,64 @@
+#
+# 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.
+#
+
+require 5.8.4;
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+# #defines.
+my @defines = ( DEFINE => exists($ENV{RELEASE_BUILD}) ? '-DNDEBUG' : '' );
+
+# List of POD pages to install.
+my @man3pods = ( MAN3PODS => {} );
+
+
+#
+# If not building as part of ON.
+#
+if (! exists($ENV{CODEMGR_WS})) {
+
+	#
+	# Suppress the setting of LD_RUN_PATH.  The ON build environment
+	# contains a modified MakeMaker that does this automatically, so we
+	# only need to do this if we are building outside of ON.
+	#
+	package MY;
+	no warnings qw(once);
+
+	#
+	# Install the POD documentation for non-ON builds.
+	#
+	my $man3pfx = '$(INST_MAN3DIR)/Sun::Solaris::Pg';
+	@man3pods = (
+	    MAN3PODS => { 'pod/Pg.pod' => $man3pfx . '.$(MAN3EXT)' }
+	);
+}
+
+WriteMakefile(
+    NAME              => 'Sun::Solaris::Pg',
+    VERSION_FROM      => 'Pg.pm',
+    @man3pods,
+);
diff --git a/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/Pg.pm b/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/Pg.pm
new file mode 100644
index 0000000000..c1d84b67d5
--- /dev/null
+++ b/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/Pg.pm
@@ -0,0 +1,1637 @@
+#! /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.
+#
+
+#
+# Pg.pm provides object-oriented interface to the Solaris
+# Processor Group kstats
+#
+# See comments in the end
+#
+
+package Sun::Solaris::Pg;
+
+use strict;
+use warnings;
+use Sun::Solaris::Kstat;
+use Carp;
+use Errno;
+use List::Util qw(max sum);
+
+our $VERSION = '1.1';
+
+#
+# Currently the OS does not have the root PG and PGs constitute a forest of
+# small trees. This module gathers all such trees under one root with ID zero.
+# If the root is present already, we do not use faked root.
+#
+
+my $ROOT_ID = 0;
+
+#
+# PG_NO_PARENT means that kstats have PG parent ID and it is set to -1
+# PG_PARENT_UNDEF means that kstats have no PG parent ID
+#
+use constant {
+	PG_NO_PARENT	=> -1,
+	PG_PARENT_UNDEF => -2,
+};
+
+#
+# Sorting order between different sharing relationships. This order is used to
+# break ties between PGs with the same number of CPUs. If there are two PGs with
+# the same set of CPUs, the one with the higher weight will be the parent of the
+# one with the lower weight.
+#
+my %relationships_order = (
+			   'CPU_PM_Idle_Power_Domain' => 1,
+			   'Integer_Pipeline' => 2,
+			   'Cache' => 3,
+			   'CPU_PM_Active_Power_Domain' => 4,
+			   'Floating_Point_Unit' => 5,
+			   'Data_Pipe_to_memory' => 6,
+			   'Memory' => 7,
+			   'Socket' => 8,
+			   'System' => 9,
+			  );
+
+#
+# Object interface to the library. These are methods that can be used by the
+# module user.
+#
+
+#
+# Create a new object representing PG
+# All the heavy lifting is performed by _init function.
+# This function performs all the Perl blessing magic.
+#
+# The new() method accepts arguments in the form of a hash. The following
+# subarguments are supported:
+#
+#   -cpudata	# Collect per-CPU data from kstats if this is T
+#   -tags	# Match PGs to physical relationships if this is T
+#   -swload	# Collect software CPU load if this is T
+#   -retry	# how many times to retry PG initialization when it fails
+#   -delay # Delay in seconds between retries
+#
+# The arguments are passed to _init().
+#
+sub new
+{
+	my $class = shift;
+	my %args = @_;
+	my $retry_count = $args{-retry} || 0;
+	my $retry_delay = $args{-delay} || 1;
+
+	my $self =  _init(@_);
+
+	#
+	# If PG initialization fails with EAGAIN error and the caller requested
+	# retries, retry initialization.
+	#
+	for (; !$self && ($! == &Errno::EAGAIN) && $retry_count;
+	     $retry_count--) {
+		select(undef,undef,undef, $retry_delay);
+		$self = _init(@_);
+	}
+
+	if ($self) {
+		bless($self, $class) if defined($class);
+		bless($self) unless defined($class);
+	}
+
+	return ($self);
+}
+
+#
+# Functions below use internal function _pg_get which returns PG hash reference
+# corresponding to PG ID specified or 'undef' if the PG can't be found.
+#
+
+#
+# All methods return 'undef' in scalar context and an empty list in list
+# context when unrecoverable errors are detected.
+#
+
+#
+# Return the root ID of PG hierarchy
+#
+sub root
+{
+	scalar @_ == 1 or _usage("root(cookie)");
+	my $self = shift;
+
+	return unless $self->{PGTREE};
+
+	return ($ROOT_ID);
+}
+
+#
+# Return list of all pgs numerically sorted In scalar context return number of
+# PGs
+#
+sub all
+{
+	scalar @_ == 1 or _usage("all(cookie)");
+	my $self = shift;
+	my $pgtree =  $self->{PGTREE} or return;
+	my @ids = keys(%{$pgtree});
+
+	return (wantarray() ? _nsort(@ids) : scalar @ids);
+}
+
+#
+# Return list of all pgs by walking the tree depth first.
+#
+sub all_depth_first
+{
+	scalar @_ == 1 or _usage("all_depth_first(cookie)");
+	my $self = shift;
+
+	_walk_depth_first($self, $self->root());
+}
+
+#
+# Return list of all pgs by walking the tree breadth first.
+#
+sub all_breadth_first
+{
+	scalar @_ == 1 or _usage("all_breadth_first(cookie)");
+	my $self = shift;
+
+	_walk_breadth_first($self, $self->root());
+}
+
+#
+# Return list of CPUs in the PG specified
+# CPUs returned are numerically sorted
+# In scalar context return number of CPUs
+#
+sub cpus
+{
+	scalar @_ == 2 or _usage("cpus(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+	my @cpus =  @{$pg->{cpus}};
+
+	return (wantarray() ? _nsort(@cpus) : _collapse(@cpus));
+}
+
+#
+# Return a parent for a given PG
+# Returns undef if there is no parent
+#
+sub parent
+{
+	scalar @_ == 2 or _usage("parent(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+	my $parent = $pg->{parent};
+
+	return (defined($parent) && $parent >= 0 ? $parent : undef);
+}
+
+#
+# Return list of children for a given PG
+# In scalar context return list of children
+#
+sub children
+{
+	scalar @_ == 2 or _usage("children(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+
+	my $children = $pg->{children} or return;
+	my @children = @{$children};
+
+	return (wantarray() ? _nsort(@children) : scalar @children);
+}
+
+#
+# Return sharing name for the PG
+#
+sub sh_name
+{
+	scalar @_ == 2 or _usage("sh_name(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+	return ($pg->{sh_name});
+}
+
+#
+# Return T if specified PG ID is a leaf PG
+#
+sub is_leaf
+{
+	scalar @_ == 2 or _usage("is_leaf(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+	return ($pg->{is_leaf});
+}
+
+#
+# Return leaf PGs
+#
+sub leaves
+{
+	scalar @_ == 1 or _usage("leaves(cookie, pg)");
+
+	my $self = shift;
+
+	return (grep { is_leaf($self, $_) } $self->all());
+}
+
+#
+# Update varying data in the snapshot
+#
+sub update
+{
+	scalar @_ == 1 or _usage("update(cookie)");
+
+	my $self = shift;
+	my $ks = $self->{KSTAT};
+
+	$ks->update();
+
+	my $pgtree = $self->{PGTREE};
+	my $pg_info = $ks->{$self->{PG_MODULE}};
+
+	#
+	# Walk PG kstats and copy updated data from kstats to the snapshot
+	#
+	foreach my $id (keys %$pg_info) {
+		my $pg = $pgtree->{$id} or next;
+
+		my $pg_ks = _kstat_get_pg($pg_info, $id,
+					  $self->{USE_OLD_KSTATS});
+		return unless $pg_ks;
+
+		#
+		# Update PG from kstats
+		#
+		$pg->{util} = $pg_ks->{hw_util};
+		$pg->{current_rate} = $pg_ks->{hw_util_rate};
+		$pg->{util_rate_max} = $pg_ks->{hw_util_rate_max};
+		$pg->{util_time_running} = $pg_ks->{hw_util_time_running};
+		$pg->{util_time_stopped} = $pg_ks->{hw_util_time_stopped};
+		$pg->{snaptime} = $pg_ks->{snaptime};
+		$pg->{generation} = $pg_ks->{generation};
+	}
+
+	#
+	# Update software load for each CPU
+	#
+	$self->{CPU_LOAD} = _get_sw_cpu_load($ks);
+
+	#
+	# Get hardware load per CPU
+	#
+	if ($self->{GET_CPU_DATA}) {
+		_get_hw_cpu_load($self);
+	}
+
+	return (1);
+}
+
+#
+# Return list of physical tags for the given PG
+#
+sub tags
+{
+	scalar @_ == 2 or _usage("tags(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+
+	my $tags = $pg->{tags} or return;
+
+	my @tags = _uniq(@{$tags});
+
+	return (wantarray() ? @tags : join (',', @tags));
+}
+
+#
+# Return list of sharing relationships in the snapshot Relationships are sorted
+# by the level in the hierarchy If any PGs are given on the command line, only
+# return sharing relationships for given PGs, but still keep them sorted.
+#
+sub sharing_relationships
+{
+	scalar @_ or _usage("sharing_relationships(cookie, [pg, ...])");
+
+	my $self = shift;
+	my @pgs = $self->all_breadth_first();
+
+	if (scalar @_ > 0) {
+		#
+		# Caller specified PGs, remove any PGs not in caller's list
+		#
+		my %seen;
+		map { $seen{$_} = 1 } @_;
+
+		# Remove any PGs not provided by user
+		@pgs = grep { $seen{$_} } @pgs;
+	}
+
+	return (_uniq(map { $self->sh_name($_) } @pgs));
+}
+
+#
+# Return PG generation number. If PG is specified in the argument, return its
+# generation, otherwise return snapshot generation.
+# Snapshot generation is calculated as the total of PG generations
+#
+sub generation
+{
+	(scalar @_ == 1 || scalar @_ == 2) or _usage("generation(cookie, [pg])");
+	my $self = shift;
+
+	if (scalar @_ == 0) {
+		my @generations = map { $_->{generation} }
+				  values %{$self->{PGTREE}};
+		return (sum(@generations));
+
+	} else {
+		my $id = shift;
+		my $pg = _pg_get($self, $id) or return;
+		return ($pg->{generation});
+	}
+}
+
+#
+# Return level of PG in the tree, starting from root.
+# PG level is cached in the $pg->{level} field.
+#
+sub level
+{
+	scalar @_ == 2 or _usage("level(cookie, pg)");
+	my $self = shift;
+	my $pgid = shift;
+	my $pg = _pg_get($self, $pgid) or return;
+
+	return $pg->{level} if defined($pg->{level});
+
+	$pg->{level} = 0;
+
+	my $parent = _pg_get($self, $pg->{parent});
+	while ($parent) {
+		$pg->{level}++;
+		$parent = _pg_get($self, $parent->{parent});
+	}
+
+	return ($pg->{level});
+}
+
+#
+# Return T if PG supports utilization We assume that utilization is supported by
+# PG if it shows any non-zero time in util_time_running. It is possible that the
+# same condition may be caused by cpustat(1) running ever since PG was created,
+# but there is not much we can do about it.
+#
+sub has_utilization
+{
+	scalar @_ == 2 or _usage("has_utilization(cookie, pg)");
+	my $pg = _pg_get(shift, shift) or return;
+
+	return ($pg->{util_time_running} != 0);
+}
+
+
+#
+# Return utilization for the PG
+# Utilization is a difference in utilization value between two snapshots.
+# We can only compare utilization between PGs having the same generation ID.
+#
+sub utilization
+{
+	scalar @_ == 3 or _usage("utilization(cookie, cookie1, pg");
+	my $c1 = shift;
+	my $c2 = shift;
+	my $id = shift;
+
+	#
+	# Since we have two cookies, update capacity in both
+	#
+	_capacity_update($c1, $c2, $id);
+
+	my $pg1 = _pg_get($c1, $id) or return;
+	my $pg2 = _pg_get($c2, $id) or return;
+
+	#
+	# Nothing to return if one of the utilizations wasn't measured
+	#
+	return unless ($pg1->{util_time_running} && $pg2->{util_time_running});
+
+	#
+	# Verify generation IDs
+	#
+	return unless $pg1->{generation} eq $pg2->{generation};
+	my $u1 = $pg1->{util};
+	my $u2 = $pg2->{util};
+	return unless defined ($u1) && defined ($u2);
+
+	return (abs($u2 - $u1));
+}
+
+#
+# Return an estimate of PG capacity Capacity is calculated as the maximum of
+# observed utilization expressed in units per second or maximum CPU frequency
+# for all CPUs.
+#
+# We store capacity per sharing relationship, assuming that the same sharing has
+# the same capacity. This may not be true for heterogeneous systems.
+#
+sub capacity
+{
+	scalar @_ == 2 or _usage("capacity(cookie, pg");
+	my $self = shift;
+	my $pgid = shift;
+	my $pg = _pg_get($self, $pgid) or return;
+	my $shname = $pg->{sh_name} or return;
+
+	return (max($self->{MAX_FREQUENCY}, $self->{CAPACITY}->{$shname}));
+}
+
+#
+# Return accuracy of utilization calculation between two snapshots The accuracy
+# is determined based on the total time spent running and not running the
+# counters. If T1 is the time counters were running during the period and T2 is
+# the time they were turned off, the accuracy is T1 / (T1 + T2), expressed in
+# percentages.
+#
+sub accuracy
+{
+	scalar @_ == 3 or _usage("accuracy(cookie, cookie1, pg)");
+	my $c1 = shift;
+	my $c2 = shift;
+	my $id = shift;
+	my $trun;
+	my $tstop;
+
+	my $pg1 = _pg_get($c1, $id) or return;
+	my $pg2 = _pg_get($c2, $id) or return;
+
+	# Both PGs should have the same generation
+	return unless $pg1->{generation} eq $pg2->{generation};
+
+	#
+	# Get time spent with running and stopped counters
+	#
+	$trun = abs($pg2->{util_time_running} -
+		    $pg1->{util_time_running});
+	$tstop = abs($pg2->{util_time_stopped} -
+		     $pg1->{util_time_stopped});
+
+	my $total = $trun + $tstop;
+
+	#
+	# Calculate accuracy as percentage
+	#
+	my $accuracy = $total ? ($trun * 100) / $total : 0;
+	$accuracy = int($accuracy + 0.5);
+	$accuracy = 100 if $accuracy > 100;
+	return ($accuracy);
+}
+
+#
+# Return time difference in seconds between two snapshots
+#
+sub tdelta
+{
+	scalar @_ == 3 or _usage("tdelta(cookie, cookie1, pg)");
+	my $c1 = shift;
+	my $c2 = shift;
+	my $id = shift;
+
+	my $pg1 = _pg_get($c1, $id) or return;
+	my $pg2 = _pg_get($c2, $id) or return;
+
+	return unless $pg1->{generation} eq $pg2->{generation};
+
+	my $t1 = $pg1->{snaptime};
+	my $t2 = $pg2->{snaptime};
+	my $delta = abs($t1 - $t2);
+	return ($delta);
+}
+
+#
+# Return software utilization between two snapshots
+# In scalar context return software load as percentage.
+# In list context return a list (USER, SYSTEM, IDLE, SWLOAD)
+# All loads are returned as percentages
+#
+sub sw_utilization
+{
+	scalar @_ == 3 or _usage("tdelta(cookie, cookie1, pg)");
+
+	my $c1 = shift;
+	my $c2 = shift;
+	my $id = shift;
+
+	my $pg1 = _pg_get($c1, $id) or return;
+	my $pg2 = _pg_get($c2, $id) or return;
+
+	return unless $pg1->{generation} eq $pg2->{generation};
+
+	my @cpus = $c1->cpus($id);
+
+	my $load1 = $c1->{CPU_LOAD};
+	my $load2 = $c2->{CPU_LOAD};
+
+	my $idle = 0;
+	my $user = 0;
+	my $sys = 0;
+	my $total = 0;
+	my $swload = 0;
+
+	foreach my $cpu (@cpus) {
+		my $ld1 = $load1->{$cpu};
+		my $ld2 = $load2->{$cpu};
+		next unless $ld1 && $ld2;
+
+		$idle += $ld2->{cpu_idle} - $ld1->{cpu_idle};
+		$user += $ld2->{cpu_user} - $ld1->{cpu_user};
+		$sys  += $ld2->{cpu_sys}  - $ld1->{cpu_sys};
+	}
+
+	$total = $idle + $user + $sys;
+
+	# Prevent division by zero
+	$total = 1 unless $total;
+
+	$swload = ($user + $sys) * 100 / $total;
+	$idle   = $idle * 100 / $total;
+	$user   = $user * 100 / $total;
+	$sys    = $sys  * 100 / $total;
+
+	return (wantarray() ? ($user, $sys, $idle, $swload) : $swload);
+}
+
+#
+# Return utilization for the PG for a given CPU
+# Utilization is a difference in utilization value between two snapshots.
+# We can only compare utilization between PGs having the same generation ID.
+#
+sub cpu_utilization
+{
+	scalar @_ == 4 or _usage("utilization(cookie, cookie1, pg, cpu");
+	my $c1 = shift;
+	my $c2 = shift;
+	my $id = shift;
+	my $cpu = shift;
+
+	my $idle = 0;
+	my $user = 0;
+	my $sys = 0;
+	my $swtotal = 0;
+	my $swload = 0;
+
+	#
+	# Since we have two cookies, update capacity in both
+	#
+	_capacity_update($c1, $c2, $id);
+
+	my $pg1 = _pg_get($c1, $id) or return;
+	my $pg2 = _pg_get($c2, $id) or return;
+
+	#
+	# Nothing to return if one of the utilizations wasn't measured
+	#
+	return unless ($pg1->{util_time_running} && $pg2->{util_time_running});
+
+	#
+	# Nothing to return if CPU data is missing
+	#
+	return unless $pg1->{cpudata} && $pg2->{cpudata};
+
+	#
+	# Verify generation IDs
+	#
+	return unless $pg1->{generation} eq $pg2->{generation};
+
+	#
+	# Get data for the given CPU
+	#
+	my $cpudata1 = $pg1->{cpudata}->{$cpu};
+	my $cpudata2 = $pg2->{cpudata}->{$cpu};
+
+	return unless $cpudata1 && $cpudata2;
+
+	return unless $cpudata1->{generation} == $cpudata2->{generation};
+
+	my $u1 = $cpudata1->{util};
+	my $u2 = $cpudata2->{util};
+	return unless defined ($u1) && defined ($u2);
+	my $hw_utilization = abs ($u1 - $u2);
+
+	#
+	# Get time spent with running and stopped counters
+	#
+	my $trun = abs($cpudata1->{util_time_running} -
+		       $cpudata2->{util_time_running});
+	my $tstop = abs($cpudata1->{util_time_stopped} -
+			$cpudata2->{util_time_stopped});
+
+	my $total = $trun + $tstop;
+
+	#
+	# Calculate accuracy as percentage
+	#
+	my $accuracy = $total ? ($trun * 100) / $total : 0;
+	$accuracy = int($accuracy + 0.5);
+	$accuracy = 100 if $accuracy > 100;
+
+	my $t1 = $cpudata1->{snaptime};
+	my $t2 = $cpudata2->{snaptime};
+	my $tdelta = abs ($t1 - $t2);
+
+	my $shname = $pg2->{sh_name} or return;
+	my $capacity = max($c2->{MAX_FREQUENCY}, $c2->{CAPACITY}->{$shname});
+	my $utilization = $hw_utilization / $tdelta;
+	$capacity = $utilization unless $capacity;
+	$utilization /= $capacity;
+	$utilization *= 100;
+
+	my $ld1 = $c1->{CPU_LOAD}->{$cpu};
+	my $ld2 = $c2->{CPU_LOAD}->{$cpu};
+
+	if ($ld1 && $ld2) {
+		$idle = $ld2->{cpu_idle} - $ld1->{cpu_idle};
+		$user = $ld2->{cpu_user} - $ld1->{cpu_user};
+		$sys  = $ld2->{cpu_sys}  - $ld1->{cpu_sys};
+
+		$swtotal = $idle + $user + $sys;
+
+		# Prevent division by zero
+		$swtotal = 1 unless $swtotal;
+
+		$swload = ($user + $sys) * 100 / $swtotal;
+		$idle   = $idle * 100 / $swtotal;
+		$user   = $user * 100 / $swtotal;
+		$sys    = $sys  * 100 / $swtotal;
+	}
+
+	return (wantarray() ?
+		($utilization, $accuracy, $hw_utilization,
+		 $swload, $user, $sys, $idle) :
+		$utilization);
+}
+
+#
+# online_cpus(kstat)
+# Return list of on-line CPUs
+#
+sub online_cpus
+{
+	scalar @_ == 1 or _usage("online_cpus(cookie)");
+
+	my $self = shift or return;
+	my $ks = $self->{KSTAT} or return;
+
+	my $cpu_info = $ks->{cpu_info} or return;
+
+	my @cpus = grep {
+		my $cp = $cpu_info->{$_}->{"cpu_info$_"};
+		my $state = $cp->{state};
+		$state eq 'on-line' || $state eq 'no-intr';
+	} keys %{$cpu_info};
+
+	return (wantarray() ? @cpus : _nsort(@cpus));
+}
+
+#
+# Support methods
+#
+# The following methods are not PG specific but are generally useful for PG
+# interface consumers
+#
+
+#
+# Sort the list numerically
+#
+sub nsort
+{
+	scalar @_ > 0 or _usage("nsort(cookie, val, ...)");
+	shift;
+
+	return (_nsort(@_));
+}
+
+#
+# Return the input list with duplicates removed.
+# Should be used in list context
+#
+sub uniq
+{
+	scalar @_ > 0 or _usage("uniq(cookie, val, ...)");
+	shift;
+
+	return (_uniq(@_));
+}
+
+#
+# Sort list numerically and remove duplicates
+# Should be called in list context
+#
+sub uniqsort
+{
+	scalar @_ > 0 or _usage("uniqsort(cookie, val, ...)");
+	shift;
+
+	return (_uniqsort(@_));
+}
+
+
+#
+# Expand all arguments and present them as a numerically sorted list
+# x,y is expanded as (x y)
+# 1-3 ranges are expandes as (1 2 3)
+#
+sub expand
+{
+	scalar @_ > 0 or _usage("expand(cookie, val, ...)");
+	shift;
+
+	return (_uniqsort(map { _expand($_) } @_));
+}
+
+#
+# Consolidate consecutive ids as start-end
+# Input: list of ids
+# Output: string with space-sepated cpu values with ranges
+#   collapsed as x-y
+#
+sub id_collapse
+{
+	scalar @_ > 0 or _usage("collapse(cookie, val, ...)");
+	shift;
+
+	return _collapse(@_);
+}
+
+#
+# Return elements of the second list not present in the first list. Both lists
+# are passed by reference.
+#
+sub set_subtract
+{
+	scalar @_ == 3 or _usage("set_subtract(cookie, left, right)");
+	shift;
+
+	return (_set_subtract(@_));
+}
+
+#
+# Return the intersection of two lists passed by reference
+# Convert the first list to a hash with seen entries marked as 1-values
+# Then grep only elements present in the first list from the second list.
+# As a little optimization, use the shorter list to build a hash.
+#
+sub intersect
+{
+	scalar @_ == 3 or _usage("intersect(cookie, left, right)");
+	shift;
+
+	return (_set_intersect(@_));
+}
+
+#
+# Return elements of the second list not present in the first list. Both lists
+# are passed by reference.
+#
+sub _set_subtract
+{
+	my ($left, $right) = @_;
+	my %seen;	# Set to 1 for everything in the first list
+	# Create a hash indexed by elements in @left with ones as a value.
+	map { $seen{$_} = 1 } @$left;
+	# Find members of @right present in @left
+	return (grep { ! $seen{$_} } @$right);
+}
+
+#
+# END OF PUBLIC INTERFACE
+#
+
+#
+# INTERNAL FUNCTIONS
+#
+
+#
+# _usage(): print error message and terminate the program.
+#
+sub _usage
+{
+	my $msg = shift;
+	Carp::croak "Usage: Sun::Solaris::Pg::$msg";
+}
+
+#
+# Sort the list numerically
+# Should be called in list context
+#
+sub _nsort
+{
+	return (sort { $a <=> $b } @_);
+}
+
+#
+# Return the input list with duplicates removed.
+# Should be used in list context
+#
+sub _uniq
+{
+	my %seen;
+	return (grep { ++$seen{$_} == 1 } @_);
+}
+
+#
+# Sort list numerically and remove duplicates
+# Should be called in list context
+#
+sub _uniqsort
+{
+	return (sort { $a <=> $b } _uniq(@_));
+}
+
+# Get PG from the snapshot by id
+sub _pg_get
+{
+	my $self = shift;
+	my $pgid = shift;
+
+	return unless defined $pgid;
+	my $pgtree = $self->{PGTREE} or return;
+
+	return ($pgtree->{$pgid});
+}
+
+#
+# Copy data from kstat representation to our representation
+# Arguments:
+#   PG kstat
+#   Reference to the list of CPUs.
+# Any CPUs in the PG kstat not present in the CPU list are ignored.
+#
+sub _pg_create_from_kstat
+{
+	my $pg_ks = shift;
+	my $all_cpus = shift;
+	my %all_cpus;
+	my $pg = ();
+
+	#
+	# Mark CPUs available
+	#
+	map { $all_cpus{$_}++ } @$all_cpus;
+
+	return unless $pg_ks;
+
+	#
+	# Convert CPU list in the kstat from x-y,z form to the proper list
+	#
+	my @cpus = _expand($pg_ks->{cpus});
+
+	#
+	# Remove any CPUs not present in the arguments
+	#
+	@cpus = grep { $all_cpus{$_} } @cpus;
+
+	#
+	# Do not create PG unless it has any CPUs
+	#
+	return unless scalar @cpus;
+
+	#
+	# Copy data to the $pg structure
+	#
+	$pg->{ncpus} = scalar @cpus;
+	$pg->{cpus} = \@cpus;
+	$pg->{id} = defined($pg_ks->{pg_id}) ? $pg_ks->{pg_id} : $pg_ks->{id};
+	$pg->{util} = $pg_ks->{hw_util};
+	$pg->{current_rate} = $pg_ks->{hw_util_rate};
+	$pg->{util_rate_max} = $pg_ks->{hw_util_rate_max};
+	$pg->{util_time_running} = $pg_ks->{hw_util_time_running};
+	$pg->{util_time_stopped} = $pg_ks->{hw_util_time_stopped};
+	$pg->{snaptime} = $pg_ks->{snaptime};
+	$pg->{generation} = $pg_ks->{generation};
+	$pg->{sh_name} = $pg_ks->{relationship} || $pg_ks->{sharing_relation};
+	$pg->{parent} = $pg_ks->{parent_pg_id};
+	$pg->{parent} = PG_PARENT_UNDEF unless defined $pg->{parent};
+	#
+	# Replace spaces with underscores in sharing names
+	#
+	$pg->{sh_name} =~ s/ /_/g;
+	$pg->{is_leaf} = 1;
+
+	return $pg;
+}
+
+#
+# Create fake root PG with all CPUs
+# Arguments: list of CPUs
+#
+sub _pg_create_root
+{
+	my $pg = ();
+	my @cpus = @_;
+
+	$pg->{id} = $ROOT_ID;
+	$pg->{ncpus} = scalar @cpus;
+	$pg->{util} = 0;
+	$pg->{current_rate} = 0;
+	$pg->{util_rate_max} = 0;
+	$pg->{util_time_running} = 0;
+	$pg->{util_time_stopped} = 0;
+	$pg->{snaptime} = 0;
+	$pg->{generation} = 0;
+	$pg->{sh_name} = 'System';
+	$pg->{is_leaf} = 0;
+	$pg->{cpus} = \@cpus;
+	$pg->{parent} = PG_NO_PARENT;
+
+	return ($pg);
+}
+
+#
+# _pg_all_from_kstats(SNAPSHOT)
+# Extract all PG information from kstats
+#
+sub _pg_all_from_kstats
+{
+	my $self = shift;
+	my $ks = $self->{KSTAT};
+	my @all_cpus = @{$self->{CPUS}};
+
+	return unless $ks;
+
+	my $pgtree = ();
+	my $pg_info = $ks->{$self->{PG_MODULE}};
+
+	#
+	# Walk all PG kstats and copy them to $pgtree->{$id}
+	#
+	foreach my $id (keys %$pg_info) {
+		my $pg_ks = _kstat_get_pg($pg_info, $id,
+					  $self->{USE_OLD_KSTATS});
+		next unless $pg_ks;
+
+		my $pg = _pg_create_from_kstat($pg_ks, \@all_cpus);
+
+		$pgtree->{$id} = $pg if $pg;
+	}
+
+	#
+	# OS does not have root PG, so create one.
+	#
+	if (!$pgtree->{$ROOT_ID}) {
+		$pgtree->{$ROOT_ID} = _pg_create_root (@all_cpus);
+	}
+
+	#
+	# Construct parent-child relationships between PGs
+	#
+
+	#
+	# Get list of PGs sorted by number of CPUs
+	# If two PGs have the same number of CPUs, sort by relationship order.
+	#
+	my @lineage = sort {
+		$a->{ncpus} <=> $b->{ncpus} ||
+		_relationship_order($a->{sh_name}) <=>
+		_relationship_order($b->{sh_name})
+	    } values %$pgtree;
+
+	#
+	# For each PG in the lineage discover its parent if it doesn't have one.
+	#
+	for (my $i = 0; $i < scalar @lineage; $i++) {
+		my $pg = $lineage[$i];
+
+		#
+		# Ignore PGs which already have parent in kstats
+		#
+		my $parent = $pg->{parent};
+		next if ($parent >= PG_NO_PARENT);
+
+		my $ncpus = $pg->{ncpus};
+		my @cpus = @{$pg->{cpus}};
+
+		#
+		# Walk the lineage, ignoring any CPUs with the same number of
+		# CPUs
+		for (my $j = $i + 1; $j < scalar @lineage; $j++) {
+			my $pg1 = $lineage[$j];
+			my @parent_cpus = @{$pg1->{cpus}};
+			if (_is_subset(\@cpus, \@parent_cpus)) {
+				$pg->{parent} = $pg1->{id};
+				last;
+			}
+		}
+	}
+
+	#
+	# Find all top-level PGs and put them under $root
+	#
+	foreach my $pgid (keys %$pgtree) {
+		next if $pgid == $ROOT_ID;
+		my $pg = $pgtree->{$pgid};
+		$pg->{parent} = $ROOT_ID unless $pg->{parent} >= 0;
+	}
+
+	#
+	# Now that we know parents, for each parent add all direct children to
+	# their parent sets
+	#
+	foreach my $pg (@lineage) {
+		my $parentid = $pg->{parent};
+		next unless defined $parentid;
+
+		my $parent = $pgtree->{$parentid};
+		push (@{$parent->{children}}, $pg->{id});
+	}
+
+	return ($pgtree);
+}
+
+#
+# Read kstats and initialize PG object
+# Collect basic information about cmt_pg
+# Add list of children and list of CPUs
+# Returns the hash reference indexed by pg id
+#
+# The _init() function accepts arguments in the form of a hash. The following
+# subarguments are supported:
+#
+#   -cpudata	# Collect per-CPU data from kstats if this is T
+#   -tags	# Match PGs to physical relationships if this is T
+#   -swload	# Collect software CPU load if this is T
+
+sub _init
+{
+	my $ks = Sun::Solaris::Kstat->new(strip_strings => 1);
+	return unless $ks;
+
+	my %args = @_;
+	my $get_cpu_data = $args{-cpudata};
+	my $get_tags = $args{-tags};
+	my $get_swload = $args{-swload};
+
+	my $self;
+
+	my $use_old_kstat_names = scalar(grep {/^pg_hw_perf/ } keys (%$ks)) == 0;
+
+	my @frequencies;
+	$self->{MAX_FREQUENCY} = 0;
+
+	$self->{PG_MODULE} = $use_old_kstat_names ? 'pg' : 'pg_hw_perf';
+	$self->{PG_CPU_MODULE} =  $use_old_kstat_names ?
+	  'pg_cpu' : 'pg_hw_perf_cpu';
+	$self->{USE_OLD_KSTATS} = $use_old_kstat_names;
+
+	$get_cpu_data = 0 unless  scalar(grep {/^$self->{PG_CPU_MODULE}/ }
+					 keys (%$ks));
+
+	# Get list of PG-related kstats
+	my $pg_keys = $use_old_kstat_names ? 'pg' : 'pg_hw';
+
+	if (scalar(grep { /^$pg_keys/ } keys (%$ks)) == 0) {
+		if (exists(&Errno::ENOTSUPP)) {
+			$! = &Errno::ENOTSUPP;
+		} else {
+			$! = 48;
+		}
+		return;
+	}
+
+
+	#
+	# Mapping of cores and chips to CPUs
+	#
+	my $hw_mapping;
+
+	#
+	# Get list of all CPUs
+	#
+	my $cpu_info = $ks->{cpu_info};
+
+	#
+	# @all-cpus is a list of all cpus
+	#
+	my @all_cpus = keys %$cpu_info;
+
+	#
+	# Save list of all CPUs in the snapshot
+	#
+	$self->{CPUS} = \@all_cpus;
+
+	#
+	# Find CPUs for each socket and chip
+	# Also while we scan CPU kstats, get maximum frequency of each CPU.
+	#
+	foreach my $id (@all_cpus) {
+		my $ci = $cpu_info->{$id}->{"cpu_info$id"};
+		next unless $ci;
+		my $core_id = $ci->{core_id};
+		my $chip_id = $ci->{chip_id};
+
+		push(@{$hw_mapping->{core}->{$core_id}}, $id)
+		  if defined $core_id;
+		push(@{$hw_mapping->{chip}->{$chip_id}}, $id)
+		  if defined $chip_id;
+
+		# Read CPU frequencies separated by commas
+		my $freqs = $ci->{supported_frequencies_Hz};
+		my $max_freq = max(split(/:/, $freqs));
+
+		# Calculate maximum frequency for the snapshot.
+		$self->{MAX_FREQUENCY} = $max_freq if
+		  $self->{MAX_FREQUENCY} < $max_freq;
+	}
+
+	$self->{KSTAT} = $ks;
+
+	#
+	# Convert kstats to PG tree
+	#
+	my $pgtree = _pg_all_from_kstats($self);
+	$self->{PGTREE} = $pgtree;
+
+	#
+	# Find capacity estimate per sharing relationship
+	#
+	foreach my $pgid (keys %$pgtree) {
+		my $pg = $pgtree->{$pgid};
+		my $shname = $pg->{sh_name};
+		my $max_rate = $pg->{util_rate_max};
+		$self->{CAPACITY}->{$shname} = $max_rate if
+		  !$self->{CAPACITY}->{$shname} ||
+		    $self->{CAPACITY}->{$shname} < $max_rate;
+	}
+
+	if ($get_tags) {
+		#
+		# Walk all PGs and mark all PGs that have corresponding hardware
+		# entities (system, chips, cores).
+		#
+		foreach my $pgid (keys %$pgtree) {
+			my $pg = $pgtree->{$pgid};
+			my @cpus = @{$pg->{cpus}};
+			next unless scalar @cpus > 1;
+
+			if (_set_equal (\@cpus, \@all_cpus)) {
+				#
+				# PG has all CPUs in the system.
+				#
+				push (@{$pg->{tags}}, 'system');
+			}
+
+			foreach my $name ('core', 'chip') {
+				my $hwdata = $hw_mapping->{$name};
+				foreach my $id (keys %$hwdata) {
+					# CPUs for this entity
+					my @hw_cpus = @{$hwdata->{$id}};
+					if (_set_equal (\@cpus, \@hw_cpus)) {
+						#
+						# PG has exactly the same CPUs
+						#
+						push (@{$pg->{tags}}, $name);
+					}
+				}
+			}
+		}
+	}
+
+	#
+	# Save software load for each CPU
+	#
+	if ($get_swload) {
+		$self->{CPU_LOAD} = _get_sw_cpu_load($ks);
+	}
+
+	#
+	# Collect per-CPU utilization data if requested
+	#
+	if ($get_cpu_data) {
+		_get_hw_cpu_load($self);
+	}
+
+	$self->{GET_CPU_DATA} = $get_cpu_data;
+
+	#
+	# Verify that in the end we have the same PG generation for each PG
+	#
+	if (! _same_generation($self)) {
+		$! = &Errno::EAGAIN;
+		return;
+	}
+
+	return ($self);
+}
+
+#
+# Verify that topology is the same as at the time snapshot was created
+#
+sub _same_generation
+{
+	my $self = shift;
+	my $pgtree =  $self->{PGTREE} or return;
+
+	return (0) unless $self;
+
+	my $ks = $self->{KSTAT};
+	$ks->update();
+	my $pg_info = $ks->{$self->{PG_MODULE}};
+	foreach my $id (keys %$pg_info) {
+		my $pg = $pgtree->{$id} or next;
+
+		my $pg_ks = _kstat_get_pg($pg_info, $id,
+					  $self->{USE_OLD_KSTATS});
+		return unless $pg_ks;
+		return (0) unless $pg->{generation} == $pg_ks->{generation};
+	}
+	return (1);
+}
+
+#
+# Update capacity for both PGs
+#
+sub _capacity_update
+{
+	my $c1 = shift;
+	my $c2 = shift;
+
+	my $pgtree1 = $c1->{PGTREE};
+	my $pgtree2 = $c2->{PGTREE};
+
+	foreach my $pgid (keys %$pgtree1) {
+		my $pg1 = $pgtree1->{$pgid};
+		my $pg2 = $pgtree2->{$pgid};
+		next unless $pg1 && $pg2;
+		next unless $pg1->{generation} != $pg2->{generation};
+		my $shname1 = $pg1->{sh_name};
+		my $shname2 = $pg2->{sh_name};
+		next unless $shname1 eq $shname2;
+		my $max_rate = max($pg1->{util_rate_max}, $pg2->{util_rate_max});
+
+		my $utilization = abs($pg1->{util} - $pg2->{util});
+		my $tdelta = abs($pg1->{snaptime} - $pg2->{snaptime});
+		$utilization /= $tdelta if $utilization && $tdelta;
+		$max_rate = $utilization if
+		  $utilization && $max_rate < $utilization;
+
+		$c1->{CAPACITY}->{$shname1} = $max_rate if
+		  !$c1->{CAPACITY}->{$shname1} ||
+		    !$c1->{CAPACITY}->{$shname1} < $max_rate;
+		$c2->{CAPACITY}->{$shname2} = $max_rate if
+		  !$c2->{CAPACITY}->{$shname2} ||
+		    !$c2->{CAPACITY}->{$shname2} < $max_rate;
+	}
+}
+
+#
+# Return list of PGs breadth first
+#
+sub _walk_depth_first
+{
+	my $p = shift;
+	# Nothing to do if list is empty
+	return unless scalar (@_);
+
+	return (map { ($_, _walk_depth_first ($p, $p->children($_))) } @_);
+}
+
+#
+# Return list of PGs breadth first
+#
+sub _walk_breadth_first
+{
+	my $p = shift;
+	# Nothing to do if list is empty
+	return unless scalar (@_);
+
+	return (@_, _walk_breadth_first($p, map { $p->children($_) } @_));
+}
+
+#
+# Given the kstat reference (already hashed by module name) and PG ID return the
+# corresponding kstat.
+#
+sub _kstat_get_pg
+{
+	my $mod = shift;
+	my $pgid = shift;
+	my $use_old_kstats = shift;
+
+	my $id_field = $use_old_kstats ? 'id' : 'pg_id';
+
+	return ($mod->{$pgid}->{hardware}) if $use_old_kstats;
+
+	my @instances = grep { $_->{$id_field} == $pgid }
+	  values(%{$mod->{$pgid}});
+	return ($instances[0]);
+}
+
+######################################################################
+# Set routines
+#######################################################################
+#
+# Return T if one list contains all the elements of another list.
+# All lists are passed by reference
+#
+sub _is_subset
+{
+	my ($left, $right) = @_;
+	my %seen;	# Set to 1 for everything in the first list
+	# Put the shortest list in $left
+
+	Carp::croak "invalid left argument" unless ref ($left) eq 'ARRAY';
+	Carp::croak "invalid right argument" unless ref ($right) eq 'ARRAY';
+
+	# Create a hash indexed by elements in @right with ones as a value.
+	map { $seen{$_} = 1 } @$right;
+
+	# Find members of @left not present in @right
+	my @extra = grep { !$seen{$_} } @$left;
+	return (!scalar(@extra));
+}
+
+sub _is_member
+{
+	my $set = shift;
+	my $element = shift;
+	my %seen;
+
+	map { $seen{$_} = 1 } @$set;
+
+	return ($seen{$element});
+}
+
+#
+# Return T if C1 and C2 contain the same elements
+#
+sub _set_equal
+{
+	my $c1 = shift;
+	my $c2 = shift;
+
+	return 0 unless scalar @$c1 == scalar @$c2;
+
+	return (_is_subset($c1, $c2) && _is_subset($c2, $c1));
+}
+
+#
+# Return the intersection of two lists passed by reference
+# Convert the first list to a hash with seen entries marked as 1-values
+# Then grep only elements present in the first list from the second list.
+# As a little optimization, use the shorter list to build a hash.
+#
+sub _set_intersect
+{
+	my ($left, $right) = @_;
+	my %seen;	# Set to 1 for everything in the first list
+	# Put the shortest list in $left
+	scalar @$left <= scalar @$right or ($right, $left) = ($left, $right);
+
+	# Create a hash indexed by elements in @left with ones as a value.
+	map { $seen{$_} = 1 } @$left;
+	# Find members of @right present in @left
+	return (grep { $seen{$_} } @$right);
+}
+
+#
+# Expand start-end into the list of values
+# Input: string containing a single numeric ID or x-y range
+# Output: single value or a list of values
+# Ranges with start being more than end are inverted
+#
+sub _expand
+{
+	# Skip the first argument if it is the object reference
+	shift if ref $@[0] eq 'HASH';
+
+	my $arg = shift;
+
+	return unless defined $arg;
+
+	my @args = split /,/, $arg;
+
+	return map { _expand($_) } @args if scalar @args > 1;
+
+	$arg = shift @args;
+	return unless defined $arg;
+
+	if ($arg =~ m/^\d+$/) {
+		# single number
+		return ($arg);
+	} elsif ($arg =~ m/^(\d+)\-(\d+)$/) {
+		my ($start, $end) = ($1, $2);	# $start-$end
+		# Reverse the interval if start > end
+		($start, $end) = ($end, $start) if $start > $end;
+		return ($start .. $end);
+	} else {
+		return $arg;
+	}
+	return;
+}
+
+#
+# Consolidate consecutive ids as start-end
+# Input: list of ids
+# Output: string with space-sepated cpu values with ranges
+#   collapsed as x-y
+#
+sub _collapse
+{
+	return ('') unless @_;
+	my @args = _uniqsort(@_);
+	my $start = shift(@args);
+	my $result = '';
+	my $end = $start;	# Initial range consists of the first element
+	foreach my $el (@args) {
+		if (!$el =~ /^\d+$/) {
+			$result = "$result $el";
+			$end = $el;
+		} elsif ($el == ($end + 1)) {
+			#
+			# Got consecutive ID, so extend end of range without
+			# printing anything since the range may extend further
+			#
+			$end = $el;
+		} else {
+			#
+			# Next ID is not consecutive, so print IDs gotten so
+			# far.
+			#
+			if ($end > $start + 1) {	# range
+				$result = "$result $start-$end";
+			} elsif ($end > $start) {	# different values
+				$result = "$result $start $end";
+			} else {	# same value
+				$result = "$result $start";
+			}
+
+			# Try finding consecutive range starting from this ID
+			$start = $end = $el;
+		}
+	}
+
+	# Print last ID(s)
+	if (! ($end =~ /^\d+$/)) {
+		$result = "$result $end";
+	} elsif ($end > $start + 1) {
+		$result = "$result $start-$end";
+	} elsif ($end > $start) {
+		$result = "$result $start $end";
+	} else {
+		$result = "$result $start";
+	}
+	# Remove any spaces in the beginning
+	$result =~ s/^\s+//;
+	return ($result);
+}
+
+#
+# get relationship order from relationship name.
+# return 0 for all unknown names.
+#
+sub _relationship_order
+{
+	my $name = shift;
+	return ($relationships_order{$name} || 0);
+}
+
+#
+# Get software load for each CPU from kstats
+# Argument: kstat reference
+# Returns: reference to the hash with 
+# cpu_idle, cpu_user, cpu_sys keys.
+#
+sub _get_sw_cpu_load
+{
+	my $ks = shift or return;
+
+	my $loads;
+	my $sys_ks = $ks->{cpu};
+	foreach my $cpu (keys %$sys_ks) {
+		my $sys = $sys_ks->{$cpu}->{sys};
+		$loads->{$cpu}->{cpu_idle} = $sys->{cpu_ticks_idle};
+		$loads->{$cpu}->{cpu_user} = $sys->{cpu_ticks_user};
+		$loads->{$cpu}->{cpu_sys} = $sys->{cpu_ticks_kernel};
+	}
+
+	return ($loads);
+}
+
+#
+# Get software load for each CPU from kstats
+# Arguments:
+#  pgtree reference
+#  kstat reference
+#
+# Returns: nothing
+# Stores CPU load in the $pg->{cpudata} hash for each PG
+#
+sub _get_hw_cpu_load
+{
+	my $self = shift;
+	my $pgtree = $self->{PGTREE};
+	my $ks = $self->{KSTAT};
+
+	my $pg_cpu_ks = $ks->{$self->{PG_CPU_MODULE}};
+
+	foreach my $pgid (keys %$pgtree) {
+		my $pg = $pgtree->{$pgid};
+		my @cpus = @{$pg->{cpus}};
+		my $cpu;
+		my $pg_id;
+		foreach my $cpu (keys %$pg_cpu_ks) {
+			next unless _is_member(\@cpus, $cpu);
+			my $cpu_hw_data = $pg_cpu_ks->{$cpu};
+			foreach my $hw (keys %$cpu_hw_data) {
+				my $cpudata = $cpu_hw_data->{$hw};
+
+				#
+				# Only consider information for this PG
+				#
+				next unless $cpudata->{pg_id} == $pgid;
+
+				$pg->{cpudata}->{$cpu}->{generation} =
+				  $cpudata->{generation};
+				$pg->{cpudata}->{$cpu}->{util} =
+				  $cpudata->{hw_util};
+				$pg->{cpudata}->{$cpu}->{util_time_running} =
+				  $cpudata->{hw_util_time_running};
+				$pg->{cpudata}->{$cpu}->{util_time_stopped} =
+				  $cpudata->{hw_util_time_stopped};
+				$pg->{cpudata}->{$cpu}->{snaptime} =
+				  $cpudata->{snaptime};
+			}
+		}
+	}
+}
+
+1;
+
+__END__
+
+#
+# The information about PG hierarchy is contained in a object return by the
+# new() method.
+#
+# This module can deal with old PG kstats that have 'pg' and 'pg_cpu' as module
+# names as well as new PG kstats which use 'pg_hw_perf' and ''pg_hw_perf_cpu' as
+# the module name.
+#
+# The object contains the following fields:
+#
+#   CPUS		List of all CPUs present.
+#   CAPACITY		Estimate of capacity for each sharing
+#   PGTREE		The PG tree. See below for the tree representation.
+#
+#   PG_MODULE 		Module name for the PG kstats. It is either 'pg' for
+#			 old style kstats, or 'pg_hw_perf' for new style kstats.
+#
+#   MAX_FREQUENCY	Maximum CPU frequency
+#   USE_OLD_KSTATS	True if we are dealing with old style kstats
+#   KSTAT		The kstat object used to generate this hierarchy.
+#
+# The PG tree is represented as a hash table indexed by PG ID. Each element of
+# the table is the hash reference with the following fields:
+#
+#   children		Reference to the list of children PG IDs
+#   cpus		Reference to the list of cpu IDs in the PG
+#   current_rate	Current utilization rate
+#   generation		PG generation
+#   id			PG id
+#   ncpus		number of CPUs in the PG
+#   parent		PG parent id, or -1 if there is none.
+#   sh_name		Sharing name
+#   snaptime		Snapshot time
+#   util		Hardware utilization
+#   util_rate_max	Maximum utilization rate
+#   util_time_running	Time (in nanoseconds) when utilization data is collected
+#   util_time_stopped	Time when utilization data is not collected
+#
+# The fields (with the exception of 'children') are a copy of the data from
+# kstats.
+#
+# The PG hierarchy in the kernel does not have the root PG. We simulate the root
+# (System) PG which is the parent of top level PGs in the system. This PG always
+# has ID 0.
+#
diff --git a/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/pod/Pg.pod b/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/pod/Pg.pod
new file mode 100644
index 0000000000..97572a4e2f
--- /dev/null
+++ b/usr/src/cmd/perl/contrib/Sun/Solaris/Pg/pod/Pg.pod
@@ -0,0 +1,223 @@
+#
+# 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.
+#
+
+#
+# Sun::Solaris::Pg documentation
+#
+
+=head1 NAME
+
+Solaris::Pg - Perl interface to Processor Group kstats
+
+=head1 SYNOPSYS
+
+  use Solaris::Pg;
+
+  $p = Solaris::Pg->new(-cpudata=> 1, -tags=> 1, -swload=> 1);
+
+  @pgs = $p->all();
+
+  @pgs_depth = $p->all_depth_first();
+
+  @pgs_breadth = $p->all_breadth_first();
+
+  @leaves = $p->leaves();
+
+  $root = $p->root;
+
+  $p->update();
+
+  $leaf = $leaves[0];
+
+  $name = $p->sh_name($leaf);
+
+  @names = $p->sharing_relationships();
+
+  @tags = $p->tags($leaf);
+
+  $p1 = Solaris::Pg->new(-cpudata=> 1, -tags=> 1, -swload=> 1);
+
+  if ($p->has_utilization()) {
+    $utilization = $p->utilization($p1, $leaf);
+    $capacity = $p->capacity($p1, $leaf);
+    $accuracy = $p->accuracy($p1, $leaf);
+    $tdelta = $p->tdelta($p1);
+  }
+
+  $sw_utilization = $p->sw_utilization($p1, $leaf);)
+
+
+=head1 DESCRIPTION
+
+The Solaris::Pg module provides an interface to the Solaris PG information
+available through B<pg> and B<pg_cpu> kstats. The module provides an object
+oriented interface.
+
+=head1 METHODS
+
+=head2 new
+
+Create a new Pg instance. The new() function accepts arguments in the form of a
+hash. The following subarguments are supported:
+
+=over
+
+=item -cpudata
+
+Collect per-CPU data from kstats if this is True.
+
+=item  -tags
+
+Match PGs to physical relationships if this is True.
+
+=item  -swload
+
+Collect software CPU load if this is True.
+
+=back
+
+=head2 root
+
+Return ID of the root of Processor Group hierarchy.
+
+=head2 all
+
+Return list of all PGs sorted by ID.
+
+=head2 all_depth_first()
+
+Return list of all PGs sorted by walking the PG hierarchy depth first, starting
+from root.
+
+=head2 all_breadth_first()
+
+Return list of all PGs sorted by walking the PG hierarchy breadth first,
+starting from root.
+
+=head2 cpus(PG)
+
+Return list of all CPUs in the PG specified. The list is sorted by CPU ID.
+
+=head2 generation([PG])
+
+Return the generation number for the given PG. Without arguments, return the
+generation number for the whole snapshot. Different generation number means that
+PG configuration may have changed.
+
+=head2 parent(PG)
+
+Return parent ID or undef if there is no parent.
+
+=head2 children(PG)
+
+Return list of children for the PG.
+
+=head2 is_leaf(PG)
+
+Returns T iff PG is leaf.
+
+=head2 leaves
+
+Returns list of leaf PGs.
+
+=head2 level(PG)
+
+Return the numeric level of PG in the hierarchy, starting from root which has
+level zero.
+
+=head2 sh_name(PG)
+
+Returns sharing name for the PG.
+
+=head2  sharing_relationships([PG], ...)
+
+Without any arguments, returns the list of sharing relationships in the
+snapshot. Relationships are sorted by the level in the hierarchy If any PGs are
+given on the command line, only return sharing relationships for given PGs, but
+still keep them sorted.
+
+=head2 tags(PG)
+
+Return list of strings describing physical relationships ('core', 'chip') for the given PG.
+
+=head2 update()
+
+Update utilization and generation data in the PG snapshot.
+
+=head2 has_utilization(PG)
+
+Returns True if given PG hasd data about hardware utilization.
+
+=head2 utilization(PGOBJ, PG)
+
+Return numeric utilization for the time interval represented by two PG objects
+for the given PG. Utilization is a difference in utilization value between two
+snapshots. The given PG must belong to the same generation in both snapshots.
+Returns B<undef> if utilization can not be obtained.
+
+=head2 sw_utilization(PGOBJ, PG)
+
+Return numeric software utilization for the time interval represented by two PG
+objects for the given PG. Utilization is a difference in utilization value
+between two snapshots. The given PG must belong to the same generation in both
+snapshots. Returns B<undef> if utilization can not be obtained. Software
+utilization is combined CPU load for all CPUs in the PG. Returns B<undef> if
+utilization can not be obtained.
+
+=head2 sw_utilization(PGOBJ, PG, CPU)
+
+Return utilization for the PG for a given CPU in a given PG. Utilization is a
+difference in utilization value between two snapshots. We can only compare
+utilization between PGs having the same generation ID. Returns B<undef> if
+utilization can not be obtained.
+
+=head2 capacity(PGOBJ, PG)
+
+Return numeric capacity for the time interval represented by two PG objects for
+the given PG. Note that the actual capacity is the maximum of all capacities
+across all PGs of this type.The given PG must belong to the same generation in
+both snapshots. Returns B<undef> if capacities can not be obtained.
+
+=head2 accuracy(PGOBJ, PG)
+
+Return accuracy of utilization calculation between two snapshots The accuracy is
+determined based on the total time spent running and not running the counters.
+If T1 is the time counters were running during the period and T2 is the time
+they were turned off, the accuracy is T1 / (T1 + T2), expressed in percentages.
+
+=head2 tdelta(PGOBJ, PG)
+
+Return time interval between two snapshots for the given PG. The time is expressed in seconds and is a floating-point number.
+
+=head2 EXPORT
+
+None by default.
+
+=head1 SEE ALSO
+
+L<pginfo(1)>, L<pgstat(1)>
+
+=cut
+
diff --git a/usr/src/cmd/perl/skel/Makefile b/usr/src/cmd/perl/skel/Makefile
index 30d649b516..8814ec4a30 100644
--- a/usr/src/cmd/perl/skel/Makefile
+++ b/usr/src/cmd/perl/skel/Makefile
@@ -54,7 +54,8 @@ PERL_DYNAMIC_EXT = \
 # Add any pure-perl extensions here.
 PERL_NONXS_EXT = \
     $(SUN_SOLARIS)/BSM \
-    $(SUN_SOLARIS)/PerlGcc
+    $(SUN_SOLARIS)/PerlGcc \
+    $(SUN_SOLARIS)/Pg
 
 PERL_EXT = $(PERL_DYNAMIC_EXT) $(PERL_NONXS_EXT)
 PERL_EXT_MAKEFILES = $(PERL_EXT:%=%/Makefile)