1*d3c97224SAlexander Kolbasov#! /usr/perl5/bin/perl
2*d3c97224SAlexander Kolbasov#
3*d3c97224SAlexander Kolbasov# CDDL HEADER START
4*d3c97224SAlexander Kolbasov#
5*d3c97224SAlexander Kolbasov# The contents of this file are subject to the terms of the
6*d3c97224SAlexander Kolbasov# Common Development and Distribution License (the "License").
7*d3c97224SAlexander Kolbasov# You may not use this file except in compliance with the License.
8*d3c97224SAlexander Kolbasov#
9*d3c97224SAlexander Kolbasov# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10*d3c97224SAlexander Kolbasov# or http://www.opensolaris.org/os/licensing.
11*d3c97224SAlexander Kolbasov# See the License for the specific language governing permissions
12*d3c97224SAlexander Kolbasov# and limitations under the License.
13*d3c97224SAlexander Kolbasov#
14*d3c97224SAlexander Kolbasov# When distributing Covered Code, include this CDDL HEADER in each
15*d3c97224SAlexander Kolbasov# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16*d3c97224SAlexander Kolbasov# If applicable, add the following below this CDDL HEADER, with the
17*d3c97224SAlexander Kolbasov# fields enclosed by brackets "[]" replaced with your own identifying
18*d3c97224SAlexander Kolbasov# information: Portions Copyright [yyyy] [name of copyright owner]
19*d3c97224SAlexander Kolbasov#
20*d3c97224SAlexander Kolbasov# CDDL HEADER END
21*d3c97224SAlexander Kolbasov#
22*d3c97224SAlexander Kolbasov
23*d3c97224SAlexander Kolbasov#
24*d3c97224SAlexander Kolbasov# Copyright (c) 2010, Oracle and/or its affiliates. All rights reserved.
25*d3c97224SAlexander Kolbasov#
26*d3c97224SAlexander Kolbasov
27*d3c97224SAlexander Kolbasov#
28*d3c97224SAlexander Kolbasov# Pg.pm provides object-oriented interface to the Solaris
29*d3c97224SAlexander Kolbasov# Processor Group kstats
30*d3c97224SAlexander Kolbasov#
31*d3c97224SAlexander Kolbasov# See comments in the end
32*d3c97224SAlexander Kolbasov#
33*d3c97224SAlexander Kolbasov
34*d3c97224SAlexander Kolbasovpackage Sun::Solaris::Pg;
35*d3c97224SAlexander Kolbasov
36*d3c97224SAlexander Kolbasovuse strict;
37*d3c97224SAlexander Kolbasovuse warnings;
38*d3c97224SAlexander Kolbasovuse Sun::Solaris::Kstat;
39*d3c97224SAlexander Kolbasovuse Carp;
40*d3c97224SAlexander Kolbasovuse Errno;
41*d3c97224SAlexander Kolbasovuse List::Util qw(max sum);
42*d3c97224SAlexander Kolbasov
43*d3c97224SAlexander Kolbasovour $VERSION = '1.1';
44*d3c97224SAlexander Kolbasov
45*d3c97224SAlexander Kolbasov#
46*d3c97224SAlexander Kolbasov# Currently the OS does not have the root PG and PGs constitute a forest of
47*d3c97224SAlexander Kolbasov# small trees. This module gathers all such trees under one root with ID zero.
48*d3c97224SAlexander Kolbasov# If the root is present already, we do not use faked root.
49*d3c97224SAlexander Kolbasov#
50*d3c97224SAlexander Kolbasov
51*d3c97224SAlexander Kolbasovmy $ROOT_ID = 0;
52*d3c97224SAlexander Kolbasov
53*d3c97224SAlexander Kolbasov#
54*d3c97224SAlexander Kolbasov# PG_NO_PARENT means that kstats have PG parent ID and it is set to -1
55*d3c97224SAlexander Kolbasov# PG_PARENT_UNDEF means that kstats have no PG parent ID
56*d3c97224SAlexander Kolbasov#
57*d3c97224SAlexander Kolbasovuse constant {
58*d3c97224SAlexander Kolbasov	PG_NO_PARENT	=> -1,
59*d3c97224SAlexander Kolbasov	PG_PARENT_UNDEF => -2,
60*d3c97224SAlexander Kolbasov};
61*d3c97224SAlexander Kolbasov
62*d3c97224SAlexander Kolbasov#
63*d3c97224SAlexander Kolbasov# Sorting order between different sharing relationships. This order is used to
64*d3c97224SAlexander Kolbasov# break ties between PGs with the same number of CPUs. If there are two PGs with
65*d3c97224SAlexander Kolbasov# the same set of CPUs, the one with the higher weight will be the parent of the
66*d3c97224SAlexander Kolbasov# one with the lower weight.
67*d3c97224SAlexander Kolbasov#
68*d3c97224SAlexander Kolbasovmy %relationships_order = (
69*d3c97224SAlexander Kolbasov			   'CPU_PM_Idle_Power_Domain' => 1,
70*d3c97224SAlexander Kolbasov			   'Integer_Pipeline' => 2,
71*d3c97224SAlexander Kolbasov			   'Cache' => 3,
72*d3c97224SAlexander Kolbasov			   'CPU_PM_Active_Power_Domain' => 4,
73*d3c97224SAlexander Kolbasov			   'Floating_Point_Unit' => 5,
74*d3c97224SAlexander Kolbasov			   'Data_Pipe_to_memory' => 6,
75*d3c97224SAlexander Kolbasov			   'Memory' => 7,
76*d3c97224SAlexander Kolbasov			   'Socket' => 8,
77*d3c97224SAlexander Kolbasov			   'System' => 9,
78*d3c97224SAlexander Kolbasov			  );
79*d3c97224SAlexander Kolbasov
80*d3c97224SAlexander Kolbasov#
81*d3c97224SAlexander Kolbasov# Object interface to the library. These are methods that can be used by the
82*d3c97224SAlexander Kolbasov# module user.
83*d3c97224SAlexander Kolbasov#
84*d3c97224SAlexander Kolbasov
85*d3c97224SAlexander Kolbasov#
86*d3c97224SAlexander Kolbasov# Create a new object representing PG
87*d3c97224SAlexander Kolbasov# All the heavy lifting is performed by _init function.
88*d3c97224SAlexander Kolbasov# This function performs all the Perl blessing magic.
89*d3c97224SAlexander Kolbasov#
90*d3c97224SAlexander Kolbasov# The new() method accepts arguments in the form of a hash. The following
91*d3c97224SAlexander Kolbasov# subarguments are supported:
92*d3c97224SAlexander Kolbasov#
93*d3c97224SAlexander Kolbasov#   -cpudata	# Collect per-CPU data from kstats if this is T
94*d3c97224SAlexander Kolbasov#   -tags	# Match PGs to physical relationships if this is T
95*d3c97224SAlexander Kolbasov#   -swload	# Collect software CPU load if this is T
96*d3c97224SAlexander Kolbasov#   -retry	# how many times to retry PG initialization when it fails
97*d3c97224SAlexander Kolbasov#   -delay # Delay in seconds between retries
98*d3c97224SAlexander Kolbasov#
99*d3c97224SAlexander Kolbasov# The arguments are passed to _init().
100*d3c97224SAlexander Kolbasov#
101*d3c97224SAlexander Kolbasovsub new
102*d3c97224SAlexander Kolbasov{
103*d3c97224SAlexander Kolbasov	my $class = shift;
104*d3c97224SAlexander Kolbasov	my %args = @_;
105*d3c97224SAlexander Kolbasov	my $retry_count = $args{-retry} || 0;
106*d3c97224SAlexander Kolbasov	my $retry_delay = $args{-delay} || 1;
107*d3c97224SAlexander Kolbasov
108*d3c97224SAlexander Kolbasov	my $self =  _init(@_);
109*d3c97224SAlexander Kolbasov
110*d3c97224SAlexander Kolbasov	#
111*d3c97224SAlexander Kolbasov	# If PG initialization fails with EAGAIN error and the caller requested
112*d3c97224SAlexander Kolbasov	# retries, retry initialization.
113*d3c97224SAlexander Kolbasov	#
114*d3c97224SAlexander Kolbasov	for (; !$self && ($! == &Errno::EAGAIN) && $retry_count;
115*d3c97224SAlexander Kolbasov	     $retry_count--) {
116*d3c97224SAlexander Kolbasov		select(undef,undef,undef, $retry_delay);
117*d3c97224SAlexander Kolbasov		$self = _init(@_);
118*d3c97224SAlexander Kolbasov	}
119*d3c97224SAlexander Kolbasov
120*d3c97224SAlexander Kolbasov	if ($self) {
121*d3c97224SAlexander Kolbasov		bless($self, $class) if defined($class);
122*d3c97224SAlexander Kolbasov		bless($self) unless defined($class);
123*d3c97224SAlexander Kolbasov	}
124*d3c97224SAlexander Kolbasov
125*d3c97224SAlexander Kolbasov	return ($self);
126*d3c97224SAlexander Kolbasov}
127*d3c97224SAlexander Kolbasov
128*d3c97224SAlexander Kolbasov#
129*d3c97224SAlexander Kolbasov# Functions below use internal function _pg_get which returns PG hash reference
130*d3c97224SAlexander Kolbasov# corresponding to PG ID specified or 'undef' if the PG can't be found.
131*d3c97224SAlexander Kolbasov#
132*d3c97224SAlexander Kolbasov
133*d3c97224SAlexander Kolbasov#
134*d3c97224SAlexander Kolbasov# All methods return 'undef' in scalar context and an empty list in list
135*d3c97224SAlexander Kolbasov# context when unrecoverable errors are detected.
136*d3c97224SAlexander Kolbasov#
137*d3c97224SAlexander Kolbasov
138*d3c97224SAlexander Kolbasov#
139*d3c97224SAlexander Kolbasov# Return the root ID of PG hierarchy
140*d3c97224SAlexander Kolbasov#
141*d3c97224SAlexander Kolbasovsub root
142*d3c97224SAlexander Kolbasov{
143*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("root(cookie)");
144*d3c97224SAlexander Kolbasov	my $self = shift;
145*d3c97224SAlexander Kolbasov
146*d3c97224SAlexander Kolbasov	return unless $self->{PGTREE};
147*d3c97224SAlexander Kolbasov
148*d3c97224SAlexander Kolbasov	return ($ROOT_ID);
149*d3c97224SAlexander Kolbasov}
150*d3c97224SAlexander Kolbasov
151*d3c97224SAlexander Kolbasov#
152*d3c97224SAlexander Kolbasov# Return list of all pgs numerically sorted In scalar context return number of
153*d3c97224SAlexander Kolbasov# PGs
154*d3c97224SAlexander Kolbasov#
155*d3c97224SAlexander Kolbasovsub all
156*d3c97224SAlexander Kolbasov{
157*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("all(cookie)");
158*d3c97224SAlexander Kolbasov	my $self = shift;
159*d3c97224SAlexander Kolbasov	my $pgtree =  $self->{PGTREE} or return;
160*d3c97224SAlexander Kolbasov	my @ids = keys(%{$pgtree});
161*d3c97224SAlexander Kolbasov
162*d3c97224SAlexander Kolbasov	return (wantarray() ? _nsort(@ids) : scalar @ids);
163*d3c97224SAlexander Kolbasov}
164*d3c97224SAlexander Kolbasov
165*d3c97224SAlexander Kolbasov#
166*d3c97224SAlexander Kolbasov# Return list of all pgs by walking the tree depth first.
167*d3c97224SAlexander Kolbasov#
168*d3c97224SAlexander Kolbasovsub all_depth_first
169*d3c97224SAlexander Kolbasov{
170*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("all_depth_first(cookie)");
171*d3c97224SAlexander Kolbasov	my $self = shift;
172*d3c97224SAlexander Kolbasov
173*d3c97224SAlexander Kolbasov	_walk_depth_first($self, $self->root());
174*d3c97224SAlexander Kolbasov}
175*d3c97224SAlexander Kolbasov
176*d3c97224SAlexander Kolbasov#
177*d3c97224SAlexander Kolbasov# Return list of all pgs by walking the tree breadth first.
178*d3c97224SAlexander Kolbasov#
179*d3c97224SAlexander Kolbasovsub all_breadth_first
180*d3c97224SAlexander Kolbasov{
181*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("all_breadth_first(cookie)");
182*d3c97224SAlexander Kolbasov	my $self = shift;
183*d3c97224SAlexander Kolbasov
184*d3c97224SAlexander Kolbasov	_walk_breadth_first($self, $self->root());
185*d3c97224SAlexander Kolbasov}
186*d3c97224SAlexander Kolbasov
187*d3c97224SAlexander Kolbasov#
188*d3c97224SAlexander Kolbasov# Return list of CPUs in the PG specified
189*d3c97224SAlexander Kolbasov# CPUs returned are numerically sorted
190*d3c97224SAlexander Kolbasov# In scalar context return number of CPUs
191*d3c97224SAlexander Kolbasov#
192*d3c97224SAlexander Kolbasovsub cpus
193*d3c97224SAlexander Kolbasov{
194*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("cpus(cookie, pg)");
195*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
196*d3c97224SAlexander Kolbasov	my @cpus =  @{$pg->{cpus}};
197*d3c97224SAlexander Kolbasov
198*d3c97224SAlexander Kolbasov	return (wantarray() ? _nsort(@cpus) : _collapse(@cpus));
199*d3c97224SAlexander Kolbasov}
200*d3c97224SAlexander Kolbasov
201*d3c97224SAlexander Kolbasov#
202*d3c97224SAlexander Kolbasov# Return a parent for a given PG
203*d3c97224SAlexander Kolbasov# Returns undef if there is no parent
204*d3c97224SAlexander Kolbasov#
205*d3c97224SAlexander Kolbasovsub parent
206*d3c97224SAlexander Kolbasov{
207*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("parent(cookie, pg)");
208*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
209*d3c97224SAlexander Kolbasov	my $parent = $pg->{parent};
210*d3c97224SAlexander Kolbasov
211*d3c97224SAlexander Kolbasov	return (defined($parent) && $parent >= 0 ? $parent : undef);
212*d3c97224SAlexander Kolbasov}
213*d3c97224SAlexander Kolbasov
214*d3c97224SAlexander Kolbasov#
215*d3c97224SAlexander Kolbasov# Return list of children for a given PG
216*d3c97224SAlexander Kolbasov# In scalar context return list of children
217*d3c97224SAlexander Kolbasov#
218*d3c97224SAlexander Kolbasovsub children
219*d3c97224SAlexander Kolbasov{
220*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("children(cookie, pg)");
221*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
222*d3c97224SAlexander Kolbasov
223*d3c97224SAlexander Kolbasov	my $children = $pg->{children} or return;
224*d3c97224SAlexander Kolbasov	my @children = @{$children};
225*d3c97224SAlexander Kolbasov
226*d3c97224SAlexander Kolbasov	return (wantarray() ? _nsort(@children) : scalar @children);
227*d3c97224SAlexander Kolbasov}
228*d3c97224SAlexander Kolbasov
229*d3c97224SAlexander Kolbasov#
230*d3c97224SAlexander Kolbasov# Return sharing name for the PG
231*d3c97224SAlexander Kolbasov#
232*d3c97224SAlexander Kolbasovsub sh_name
233*d3c97224SAlexander Kolbasov{
234*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("sh_name(cookie, pg)");
235*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
236*d3c97224SAlexander Kolbasov	return ($pg->{sh_name});
237*d3c97224SAlexander Kolbasov}
238*d3c97224SAlexander Kolbasov
239*d3c97224SAlexander Kolbasov#
240*d3c97224SAlexander Kolbasov# Return T if specified PG ID is a leaf PG
241*d3c97224SAlexander Kolbasov#
242*d3c97224SAlexander Kolbasovsub is_leaf
243*d3c97224SAlexander Kolbasov{
244*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("is_leaf(cookie, pg)");
245*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
246*d3c97224SAlexander Kolbasov	return ($pg->{is_leaf});
247*d3c97224SAlexander Kolbasov}
248*d3c97224SAlexander Kolbasov
249*d3c97224SAlexander Kolbasov#
250*d3c97224SAlexander Kolbasov# Return leaf PGs
251*d3c97224SAlexander Kolbasov#
252*d3c97224SAlexander Kolbasovsub leaves
253*d3c97224SAlexander Kolbasov{
254*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("leaves(cookie, pg)");
255*d3c97224SAlexander Kolbasov
256*d3c97224SAlexander Kolbasov	my $self = shift;
257*d3c97224SAlexander Kolbasov
258*d3c97224SAlexander Kolbasov	return (grep { is_leaf($self, $_) } $self->all());
259*d3c97224SAlexander Kolbasov}
260*d3c97224SAlexander Kolbasov
261*d3c97224SAlexander Kolbasov#
262*d3c97224SAlexander Kolbasov# Update varying data in the snapshot
263*d3c97224SAlexander Kolbasov#
264*d3c97224SAlexander Kolbasovsub update
265*d3c97224SAlexander Kolbasov{
266*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("update(cookie)");
267*d3c97224SAlexander Kolbasov
268*d3c97224SAlexander Kolbasov	my $self = shift;
269*d3c97224SAlexander Kolbasov	my $ks = $self->{KSTAT};
270*d3c97224SAlexander Kolbasov
271*d3c97224SAlexander Kolbasov	$ks->update();
272*d3c97224SAlexander Kolbasov
273*d3c97224SAlexander Kolbasov	my $pgtree = $self->{PGTREE};
274*d3c97224SAlexander Kolbasov	my $pg_info = $ks->{$self->{PG_MODULE}};
275*d3c97224SAlexander Kolbasov
276*d3c97224SAlexander Kolbasov	#
277*d3c97224SAlexander Kolbasov	# Walk PG kstats and copy updated data from kstats to the snapshot
278*d3c97224SAlexander Kolbasov	#
279*d3c97224SAlexander Kolbasov	foreach my $id (keys %$pg_info) {
280*d3c97224SAlexander Kolbasov		my $pg = $pgtree->{$id} or next;
281*d3c97224SAlexander Kolbasov
282*d3c97224SAlexander Kolbasov		my $pg_ks = _kstat_get_pg($pg_info, $id,
283*d3c97224SAlexander Kolbasov					  $self->{USE_OLD_KSTATS});
284*d3c97224SAlexander Kolbasov		return unless $pg_ks;
285*d3c97224SAlexander Kolbasov
286*d3c97224SAlexander Kolbasov		#
287*d3c97224SAlexander Kolbasov		# Update PG from kstats
288*d3c97224SAlexander Kolbasov		#
289*d3c97224SAlexander Kolbasov		$pg->{util} = $pg_ks->{hw_util};
290*d3c97224SAlexander Kolbasov		$pg->{current_rate} = $pg_ks->{hw_util_rate};
291*d3c97224SAlexander Kolbasov		$pg->{util_rate_max} = $pg_ks->{hw_util_rate_max};
292*d3c97224SAlexander Kolbasov		$pg->{util_time_running} = $pg_ks->{hw_util_time_running};
293*d3c97224SAlexander Kolbasov		$pg->{util_time_stopped} = $pg_ks->{hw_util_time_stopped};
294*d3c97224SAlexander Kolbasov		$pg->{snaptime} = $pg_ks->{snaptime};
295*d3c97224SAlexander Kolbasov		$pg->{generation} = $pg_ks->{generation};
296*d3c97224SAlexander Kolbasov	}
297*d3c97224SAlexander Kolbasov
298*d3c97224SAlexander Kolbasov	#
299*d3c97224SAlexander Kolbasov	# Update software load for each CPU
300*d3c97224SAlexander Kolbasov	#
301*d3c97224SAlexander Kolbasov	$self->{CPU_LOAD} = _get_sw_cpu_load($ks);
302*d3c97224SAlexander Kolbasov
303*d3c97224SAlexander Kolbasov	#
304*d3c97224SAlexander Kolbasov	# Get hardware load per CPU
305*d3c97224SAlexander Kolbasov	#
306*d3c97224SAlexander Kolbasov	if ($self->{GET_CPU_DATA}) {
307*d3c97224SAlexander Kolbasov		_get_hw_cpu_load($self);
308*d3c97224SAlexander Kolbasov	}
309*d3c97224SAlexander Kolbasov
310*d3c97224SAlexander Kolbasov	return (1);
311*d3c97224SAlexander Kolbasov}
312*d3c97224SAlexander Kolbasov
313*d3c97224SAlexander Kolbasov#
314*d3c97224SAlexander Kolbasov# Return list of physical tags for the given PG
315*d3c97224SAlexander Kolbasov#
316*d3c97224SAlexander Kolbasovsub tags
317*d3c97224SAlexander Kolbasov{
318*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("tags(cookie, pg)");
319*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
320*d3c97224SAlexander Kolbasov
321*d3c97224SAlexander Kolbasov	my $tags = $pg->{tags} or return;
322*d3c97224SAlexander Kolbasov
323*d3c97224SAlexander Kolbasov	my @tags = _uniq(@{$tags});
324*d3c97224SAlexander Kolbasov
325*d3c97224SAlexander Kolbasov	return (wantarray() ? @tags : join (',', @tags));
326*d3c97224SAlexander Kolbasov}
327*d3c97224SAlexander Kolbasov
328*d3c97224SAlexander Kolbasov#
329*d3c97224SAlexander Kolbasov# Return list of sharing relationships in the snapshot Relationships are sorted
330*d3c97224SAlexander Kolbasov# by the level in the hierarchy If any PGs are given on the command line, only
331*d3c97224SAlexander Kolbasov# return sharing relationships for given PGs, but still keep them sorted.
332*d3c97224SAlexander Kolbasov#
333*d3c97224SAlexander Kolbasovsub sharing_relationships
334*d3c97224SAlexander Kolbasov{
335*d3c97224SAlexander Kolbasov	scalar @_ or _usage("sharing_relationships(cookie, [pg, ...])");
336*d3c97224SAlexander Kolbasov
337*d3c97224SAlexander Kolbasov	my $self = shift;
338*d3c97224SAlexander Kolbasov	my @pgs = $self->all_breadth_first();
339*d3c97224SAlexander Kolbasov
340*d3c97224SAlexander Kolbasov	if (scalar @_ > 0) {
341*d3c97224SAlexander Kolbasov		#
342*d3c97224SAlexander Kolbasov		# Caller specified PGs, remove any PGs not in caller's list
343*d3c97224SAlexander Kolbasov		#
344*d3c97224SAlexander Kolbasov		my %seen;
345*d3c97224SAlexander Kolbasov		map { $seen{$_} = 1 } @_;
346*d3c97224SAlexander Kolbasov
347*d3c97224SAlexander Kolbasov		# Remove any PGs not provided by user
348*d3c97224SAlexander Kolbasov		@pgs = grep { $seen{$_} } @pgs;
349*d3c97224SAlexander Kolbasov	}
350*d3c97224SAlexander Kolbasov
351*d3c97224SAlexander Kolbasov	return (_uniq(map { $self->sh_name($_) } @pgs));
352*d3c97224SAlexander Kolbasov}
353*d3c97224SAlexander Kolbasov
354*d3c97224SAlexander Kolbasov#
355*d3c97224SAlexander Kolbasov# Return PG generation number. If PG is specified in the argument, return its
356*d3c97224SAlexander Kolbasov# generation, otherwise return snapshot generation.
357*d3c97224SAlexander Kolbasov# Snapshot generation is calculated as the total of PG generations
358*d3c97224SAlexander Kolbasov#
359*d3c97224SAlexander Kolbasovsub generation
360*d3c97224SAlexander Kolbasov{
361*d3c97224SAlexander Kolbasov	(scalar @_ == 1 || scalar @_ == 2) or _usage("generation(cookie, [pg])");
362*d3c97224SAlexander Kolbasov	my $self = shift;
363*d3c97224SAlexander Kolbasov
364*d3c97224SAlexander Kolbasov	if (scalar @_ == 0) {
365*d3c97224SAlexander Kolbasov		my @generations = map { $_->{generation} }
366*d3c97224SAlexander Kolbasov				  values %{$self->{PGTREE}};
367*d3c97224SAlexander Kolbasov		return (sum(@generations));
368*d3c97224SAlexander Kolbasov
369*d3c97224SAlexander Kolbasov	} else {
370*d3c97224SAlexander Kolbasov		my $id = shift;
371*d3c97224SAlexander Kolbasov		my $pg = _pg_get($self, $id) or return;
372*d3c97224SAlexander Kolbasov		return ($pg->{generation});
373*d3c97224SAlexander Kolbasov	}
374*d3c97224SAlexander Kolbasov}
375*d3c97224SAlexander Kolbasov
376*d3c97224SAlexander Kolbasov#
377*d3c97224SAlexander Kolbasov# Return level of PG in the tree, starting from root.
378*d3c97224SAlexander Kolbasov# PG level is cached in the $pg->{level} field.
379*d3c97224SAlexander Kolbasov#
380*d3c97224SAlexander Kolbasovsub level
381*d3c97224SAlexander Kolbasov{
382*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("level(cookie, pg)");
383*d3c97224SAlexander Kolbasov	my $self = shift;
384*d3c97224SAlexander Kolbasov	my $pgid = shift;
385*d3c97224SAlexander Kolbasov	my $pg = _pg_get($self, $pgid) or return;
386*d3c97224SAlexander Kolbasov
387*d3c97224SAlexander Kolbasov	return $pg->{level} if defined($pg->{level});
388*d3c97224SAlexander Kolbasov
389*d3c97224SAlexander Kolbasov	$pg->{level} = 0;
390*d3c97224SAlexander Kolbasov
391*d3c97224SAlexander Kolbasov	my $parent = _pg_get($self, $pg->{parent});
392*d3c97224SAlexander Kolbasov	while ($parent) {
393*d3c97224SAlexander Kolbasov		$pg->{level}++;
394*d3c97224SAlexander Kolbasov		$parent = _pg_get($self, $parent->{parent});
395*d3c97224SAlexander Kolbasov	}
396*d3c97224SAlexander Kolbasov
397*d3c97224SAlexander Kolbasov	return ($pg->{level});
398*d3c97224SAlexander Kolbasov}
399*d3c97224SAlexander Kolbasov
400*d3c97224SAlexander Kolbasov#
401*d3c97224SAlexander Kolbasov# Return T if PG supports utilization We assume that utilization is supported by
402*d3c97224SAlexander Kolbasov# PG if it shows any non-zero time in util_time_running. It is possible that the
403*d3c97224SAlexander Kolbasov# same condition may be caused by cpustat(1) running ever since PG was created,
404*d3c97224SAlexander Kolbasov# but there is not much we can do about it.
405*d3c97224SAlexander Kolbasov#
406*d3c97224SAlexander Kolbasovsub has_utilization
407*d3c97224SAlexander Kolbasov{
408*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("has_utilization(cookie, pg)");
409*d3c97224SAlexander Kolbasov	my $pg = _pg_get(shift, shift) or return;
410*d3c97224SAlexander Kolbasov
411*d3c97224SAlexander Kolbasov	return ($pg->{util_time_running} != 0);
412*d3c97224SAlexander Kolbasov}
413*d3c97224SAlexander Kolbasov
414*d3c97224SAlexander Kolbasov
415*d3c97224SAlexander Kolbasov#
416*d3c97224SAlexander Kolbasov# Return utilization for the PG
417*d3c97224SAlexander Kolbasov# Utilization is a difference in utilization value between two snapshots.
418*d3c97224SAlexander Kolbasov# We can only compare utilization between PGs having the same generation ID.
419*d3c97224SAlexander Kolbasov#
420*d3c97224SAlexander Kolbasovsub utilization
421*d3c97224SAlexander Kolbasov{
422*d3c97224SAlexander Kolbasov	scalar @_ == 3 or _usage("utilization(cookie, cookie1, pg");
423*d3c97224SAlexander Kolbasov	my $c1 = shift;
424*d3c97224SAlexander Kolbasov	my $c2 = shift;
425*d3c97224SAlexander Kolbasov	my $id = shift;
426*d3c97224SAlexander Kolbasov
427*d3c97224SAlexander Kolbasov	#
428*d3c97224SAlexander Kolbasov	# Since we have two cookies, update capacity in both
429*d3c97224SAlexander Kolbasov	#
430*d3c97224SAlexander Kolbasov	_capacity_update($c1, $c2, $id);
431*d3c97224SAlexander Kolbasov
432*d3c97224SAlexander Kolbasov	my $pg1 = _pg_get($c1, $id) or return;
433*d3c97224SAlexander Kolbasov	my $pg2 = _pg_get($c2, $id) or return;
434*d3c97224SAlexander Kolbasov
435*d3c97224SAlexander Kolbasov	#
436*d3c97224SAlexander Kolbasov	# Nothing to return if one of the utilizations wasn't measured
437*d3c97224SAlexander Kolbasov	#
438*d3c97224SAlexander Kolbasov	return unless ($pg1->{util_time_running} && $pg2->{util_time_running});
439*d3c97224SAlexander Kolbasov
440*d3c97224SAlexander Kolbasov	#
441*d3c97224SAlexander Kolbasov	# Verify generation IDs
442*d3c97224SAlexander Kolbasov	#
443*d3c97224SAlexander Kolbasov	return unless $pg1->{generation} eq $pg2->{generation};
444*d3c97224SAlexander Kolbasov	my $u1 = $pg1->{util};
445*d3c97224SAlexander Kolbasov	my $u2 = $pg2->{util};
446*d3c97224SAlexander Kolbasov	return unless defined ($u1) && defined ($u2);
447*d3c97224SAlexander Kolbasov
448*d3c97224SAlexander Kolbasov	return (abs($u2 - $u1));
449*d3c97224SAlexander Kolbasov}
450*d3c97224SAlexander Kolbasov
451*d3c97224SAlexander Kolbasov#
452*d3c97224SAlexander Kolbasov# Return an estimate of PG capacity Capacity is calculated as the maximum of
453*d3c97224SAlexander Kolbasov# observed utilization expressed in units per second or maximum CPU frequency
454*d3c97224SAlexander Kolbasov# for all CPUs.
455*d3c97224SAlexander Kolbasov#
456*d3c97224SAlexander Kolbasov# We store capacity per sharing relationship, assuming that the same sharing has
457*d3c97224SAlexander Kolbasov# the same capacity. This may not be true for heterogeneous systems.
458*d3c97224SAlexander Kolbasov#
459*d3c97224SAlexander Kolbasovsub capacity
460*d3c97224SAlexander Kolbasov{
461*d3c97224SAlexander Kolbasov	scalar @_ == 2 or _usage("capacity(cookie, pg");
462*d3c97224SAlexander Kolbasov	my $self = shift;
463*d3c97224SAlexander Kolbasov	my $pgid = shift;
464*d3c97224SAlexander Kolbasov	my $pg = _pg_get($self, $pgid) or return;
465*d3c97224SAlexander Kolbasov	my $shname = $pg->{sh_name} or return;
466*d3c97224SAlexander Kolbasov
467*d3c97224SAlexander Kolbasov	return (max($self->{MAX_FREQUENCY}, $self->{CAPACITY}->{$shname}));
468*d3c97224SAlexander Kolbasov}
469*d3c97224SAlexander Kolbasov
470*d3c97224SAlexander Kolbasov#
471*d3c97224SAlexander Kolbasov# Return accuracy of utilization calculation between two snapshots The accuracy
472*d3c97224SAlexander Kolbasov# is determined based on the total time spent running and not running the
473*d3c97224SAlexander Kolbasov# counters. If T1 is the time counters were running during the period and T2 is
474*d3c97224SAlexander Kolbasov# the time they were turned off, the accuracy is T1 / (T1 + T2), expressed in
475*d3c97224SAlexander Kolbasov# percentages.
476*d3c97224SAlexander Kolbasov#
477*d3c97224SAlexander Kolbasovsub accuracy
478*d3c97224SAlexander Kolbasov{
479*d3c97224SAlexander Kolbasov	scalar @_ == 3 or _usage("accuracy(cookie, cookie1, pg)");
480*d3c97224SAlexander Kolbasov	my $c1 = shift;
481*d3c97224SAlexander Kolbasov	my $c2 = shift;
482*d3c97224SAlexander Kolbasov	my $id = shift;
483*d3c97224SAlexander Kolbasov	my $trun;
484*d3c97224SAlexander Kolbasov	my $tstop;
485*d3c97224SAlexander Kolbasov
486*d3c97224SAlexander Kolbasov	my $pg1 = _pg_get($c1, $id) or return;
487*d3c97224SAlexander Kolbasov	my $pg2 = _pg_get($c2, $id) or return;
488*d3c97224SAlexander Kolbasov
489*d3c97224SAlexander Kolbasov	# Both PGs should have the same generation
490*d3c97224SAlexander Kolbasov	return unless $pg1->{generation} eq $pg2->{generation};
491*d3c97224SAlexander Kolbasov
492*d3c97224SAlexander Kolbasov	#
493*d3c97224SAlexander Kolbasov	# Get time spent with running and stopped counters
494*d3c97224SAlexander Kolbasov	#
495*d3c97224SAlexander Kolbasov	$trun = abs($pg2->{util_time_running} -
496*d3c97224SAlexander Kolbasov		    $pg1->{util_time_running});
497*d3c97224SAlexander Kolbasov	$tstop = abs($pg2->{util_time_stopped} -
498*d3c97224SAlexander Kolbasov		     $pg1->{util_time_stopped});
499*d3c97224SAlexander Kolbasov
500*d3c97224SAlexander Kolbasov	my $total = $trun + $tstop;
501*d3c97224SAlexander Kolbasov
502*d3c97224SAlexander Kolbasov	#
503*d3c97224SAlexander Kolbasov	# Calculate accuracy as percentage
504*d3c97224SAlexander Kolbasov	#
505*d3c97224SAlexander Kolbasov	my $accuracy = $total ? ($trun * 100) / $total : 0;
506*d3c97224SAlexander Kolbasov	$accuracy = int($accuracy + 0.5);
507*d3c97224SAlexander Kolbasov	$accuracy = 100 if $accuracy > 100;
508*d3c97224SAlexander Kolbasov	return ($accuracy);
509*d3c97224SAlexander Kolbasov}
510*d3c97224SAlexander Kolbasov
511*d3c97224SAlexander Kolbasov#
512*d3c97224SAlexander Kolbasov# Return time difference in seconds between two snapshots
513*d3c97224SAlexander Kolbasov#
514*d3c97224SAlexander Kolbasovsub tdelta
515*d3c97224SAlexander Kolbasov{
516*d3c97224SAlexander Kolbasov	scalar @_ == 3 or _usage("tdelta(cookie, cookie1, pg)");
517*d3c97224SAlexander Kolbasov	my $c1 = shift;
518*d3c97224SAlexander Kolbasov	my $c2 = shift;
519*d3c97224SAlexander Kolbasov	my $id = shift;
520*d3c97224SAlexander Kolbasov
521*d3c97224SAlexander Kolbasov	my $pg1 = _pg_get($c1, $id) or return;
522*d3c97224SAlexander Kolbasov	my $pg2 = _pg_get($c2, $id) or return;
523*d3c97224SAlexander Kolbasov
524*d3c97224SAlexander Kolbasov	return unless $pg1->{generation} eq $pg2->{generation};
525*d3c97224SAlexander Kolbasov
526*d3c97224SAlexander Kolbasov	my $t1 = $pg1->{snaptime};
527*d3c97224SAlexander Kolbasov	my $t2 = $pg2->{snaptime};
528*d3c97224SAlexander Kolbasov	my $delta = abs($t1 - $t2);
529*d3c97224SAlexander Kolbasov	return ($delta);
530*d3c97224SAlexander Kolbasov}
531*d3c97224SAlexander Kolbasov
532*d3c97224SAlexander Kolbasov#
533*d3c97224SAlexander Kolbasov# Return software utilization between two snapshots
534*d3c97224SAlexander Kolbasov# In scalar context return software load as percentage.
535*d3c97224SAlexander Kolbasov# In list context return a list (USER, SYSTEM, IDLE, SWLOAD)
536*d3c97224SAlexander Kolbasov# All loads are returned as percentages
537*d3c97224SAlexander Kolbasov#
538*d3c97224SAlexander Kolbasovsub sw_utilization
539*d3c97224SAlexander Kolbasov{
540*d3c97224SAlexander Kolbasov	scalar @_ == 3 or _usage("tdelta(cookie, cookie1, pg)");
541*d3c97224SAlexander Kolbasov
542*d3c97224SAlexander Kolbasov	my $c1 = shift;
543*d3c97224SAlexander Kolbasov	my $c2 = shift;
544*d3c97224SAlexander Kolbasov	my $id = shift;
545*d3c97224SAlexander Kolbasov
546*d3c97224SAlexander Kolbasov	my $pg1 = _pg_get($c1, $id) or return;
547*d3c97224SAlexander Kolbasov	my $pg2 = _pg_get($c2, $id) or return;
548*d3c97224SAlexander Kolbasov
549*d3c97224SAlexander Kolbasov	return unless $pg1->{generation} eq $pg2->{generation};
550*d3c97224SAlexander Kolbasov
551*d3c97224SAlexander Kolbasov	my @cpus = $c1->cpus($id);
552*d3c97224SAlexander Kolbasov
553*d3c97224SAlexander Kolbasov	my $load1 = $c1->{CPU_LOAD};
554*d3c97224SAlexander Kolbasov	my $load2 = $c2->{CPU_LOAD};
555*d3c97224SAlexander Kolbasov
556*d3c97224SAlexander Kolbasov	my $idle = 0;
557*d3c97224SAlexander Kolbasov	my $user = 0;
558*d3c97224SAlexander Kolbasov	my $sys = 0;
559*d3c97224SAlexander Kolbasov	my $total = 0;
560*d3c97224SAlexander Kolbasov	my $swload = 0;
561*d3c97224SAlexander Kolbasov
562*d3c97224SAlexander Kolbasov	foreach my $cpu (@cpus) {
563*d3c97224SAlexander Kolbasov		my $ld1 = $load1->{$cpu};
564*d3c97224SAlexander Kolbasov		my $ld2 = $load2->{$cpu};
565*d3c97224SAlexander Kolbasov		next unless $ld1 && $ld2;
566*d3c97224SAlexander Kolbasov
567*d3c97224SAlexander Kolbasov		$idle += $ld2->{cpu_idle} - $ld1->{cpu_idle};
568*d3c97224SAlexander Kolbasov		$user += $ld2->{cpu_user} - $ld1->{cpu_user};
569*d3c97224SAlexander Kolbasov		$sys  += $ld2->{cpu_sys}  - $ld1->{cpu_sys};
570*d3c97224SAlexander Kolbasov	}
571*d3c97224SAlexander Kolbasov
572*d3c97224SAlexander Kolbasov	$total = $idle + $user + $sys;
573*d3c97224SAlexander Kolbasov
574*d3c97224SAlexander Kolbasov	# Prevent division by zero
575*d3c97224SAlexander Kolbasov	$total = 1 unless $total;
576*d3c97224SAlexander Kolbasov
577*d3c97224SAlexander Kolbasov	$swload = ($user + $sys) * 100 / $total;
578*d3c97224SAlexander Kolbasov	$idle   = $idle * 100 / $total;
579*d3c97224SAlexander Kolbasov	$user   = $user * 100 / $total;
580*d3c97224SAlexander Kolbasov	$sys    = $sys  * 100 / $total;
581*d3c97224SAlexander Kolbasov
582*d3c97224SAlexander Kolbasov	return (wantarray() ? ($user, $sys, $idle, $swload) : $swload);
583*d3c97224SAlexander Kolbasov}
584*d3c97224SAlexander Kolbasov
585*d3c97224SAlexander Kolbasov#
586*d3c97224SAlexander Kolbasov# Return utilization for the PG for a given CPU
587*d3c97224SAlexander Kolbasov# Utilization is a difference in utilization value between two snapshots.
588*d3c97224SAlexander Kolbasov# We can only compare utilization between PGs having the same generation ID.
589*d3c97224SAlexander Kolbasov#
590*d3c97224SAlexander Kolbasovsub cpu_utilization
591*d3c97224SAlexander Kolbasov{
592*d3c97224SAlexander Kolbasov	scalar @_ == 4 or _usage("utilization(cookie, cookie1, pg, cpu");
593*d3c97224SAlexander Kolbasov	my $c1 = shift;
594*d3c97224SAlexander Kolbasov	my $c2 = shift;
595*d3c97224SAlexander Kolbasov	my $id = shift;
596*d3c97224SAlexander Kolbasov	my $cpu = shift;
597*d3c97224SAlexander Kolbasov
598*d3c97224SAlexander Kolbasov	my $idle = 0;
599*d3c97224SAlexander Kolbasov	my $user = 0;
600*d3c97224SAlexander Kolbasov	my $sys = 0;
601*d3c97224SAlexander Kolbasov	my $swtotal = 0;
602*d3c97224SAlexander Kolbasov	my $swload = 0;
603*d3c97224SAlexander Kolbasov
604*d3c97224SAlexander Kolbasov	#
605*d3c97224SAlexander Kolbasov	# Since we have two cookies, update capacity in both
606*d3c97224SAlexander Kolbasov	#
607*d3c97224SAlexander Kolbasov	_capacity_update($c1, $c2, $id);
608*d3c97224SAlexander Kolbasov
609*d3c97224SAlexander Kolbasov	my $pg1 = _pg_get($c1, $id) or return;
610*d3c97224SAlexander Kolbasov	my $pg2 = _pg_get($c2, $id) or return;
611*d3c97224SAlexander Kolbasov
612*d3c97224SAlexander Kolbasov	#
613*d3c97224SAlexander Kolbasov	# Nothing to return if one of the utilizations wasn't measured
614*d3c97224SAlexander Kolbasov	#
615*d3c97224SAlexander Kolbasov	return unless ($pg1->{util_time_running} && $pg2->{util_time_running});
616*d3c97224SAlexander Kolbasov
617*d3c97224SAlexander Kolbasov	#
618*d3c97224SAlexander Kolbasov	# Nothing to return if CPU data is missing
619*d3c97224SAlexander Kolbasov	#
620*d3c97224SAlexander Kolbasov	return unless $pg1->{cpudata} && $pg2->{cpudata};
621*d3c97224SAlexander Kolbasov
622*d3c97224SAlexander Kolbasov	#
623*d3c97224SAlexander Kolbasov	# Verify generation IDs
624*d3c97224SAlexander Kolbasov	#
625*d3c97224SAlexander Kolbasov	return unless $pg1->{generation} eq $pg2->{generation};
626*d3c97224SAlexander Kolbasov
627*d3c97224SAlexander Kolbasov	#
628*d3c97224SAlexander Kolbasov	# Get data for the given CPU
629*d3c97224SAlexander Kolbasov	#
630*d3c97224SAlexander Kolbasov	my $cpudata1 = $pg1->{cpudata}->{$cpu};
631*d3c97224SAlexander Kolbasov	my $cpudata2 = $pg2->{cpudata}->{$cpu};
632*d3c97224SAlexander Kolbasov
633*d3c97224SAlexander Kolbasov	return unless $cpudata1 && $cpudata2;
634*d3c97224SAlexander Kolbasov
635*d3c97224SAlexander Kolbasov	return unless $cpudata1->{generation} == $cpudata2->{generation};
636*d3c97224SAlexander Kolbasov
637*d3c97224SAlexander Kolbasov	my $u1 = $cpudata1->{util};
638*d3c97224SAlexander Kolbasov	my $u2 = $cpudata2->{util};
639*d3c97224SAlexander Kolbasov	return unless defined ($u1) && defined ($u2);
640*d3c97224SAlexander Kolbasov	my $hw_utilization = abs ($u1 - $u2);
641*d3c97224SAlexander Kolbasov
642*d3c97224SAlexander Kolbasov	#
643*d3c97224SAlexander Kolbasov	# Get time spent with running and stopped counters
644*d3c97224SAlexander Kolbasov	#
645*d3c97224SAlexander Kolbasov	my $trun = abs($cpudata1->{util_time_running} -
646*d3c97224SAlexander Kolbasov		       $cpudata2->{util_time_running});
647*d3c97224SAlexander Kolbasov	my $tstop = abs($cpudata1->{util_time_stopped} -
648*d3c97224SAlexander Kolbasov			$cpudata2->{util_time_stopped});
649*d3c97224SAlexander Kolbasov
650*d3c97224SAlexander Kolbasov	my $total = $trun + $tstop;
651*d3c97224SAlexander Kolbasov
652*d3c97224SAlexander Kolbasov	#
653*d3c97224SAlexander Kolbasov	# Calculate accuracy as percentage
654*d3c97224SAlexander Kolbasov	#
655*d3c97224SAlexander Kolbasov	my $accuracy = $total ? ($trun * 100) / $total : 0;
656*d3c97224SAlexander Kolbasov	$accuracy = int($accuracy + 0.5);
657*d3c97224SAlexander Kolbasov	$accuracy = 100 if $accuracy > 100;
658*d3c97224SAlexander Kolbasov
659*d3c97224SAlexander Kolbasov	my $t1 = $cpudata1->{snaptime};
660*d3c97224SAlexander Kolbasov	my $t2 = $cpudata2->{snaptime};
661*d3c97224SAlexander Kolbasov	my $tdelta = abs ($t1 - $t2);
662*d3c97224SAlexander Kolbasov
663*d3c97224SAlexander Kolbasov	my $shname = $pg2->{sh_name} or return;
664*d3c97224SAlexander Kolbasov	my $capacity = max($c2->{MAX_FREQUENCY}, $c2->{CAPACITY}->{$shname});
665*d3c97224SAlexander Kolbasov	my $utilization = $hw_utilization / $tdelta;
666*d3c97224SAlexander Kolbasov	$capacity = $utilization unless $capacity;
667*d3c97224SAlexander Kolbasov	$utilization /= $capacity;
668*d3c97224SAlexander Kolbasov	$utilization *= 100;
669*d3c97224SAlexander Kolbasov
670*d3c97224SAlexander Kolbasov	my $ld1 = $c1->{CPU_LOAD}->{$cpu};
671*d3c97224SAlexander Kolbasov	my $ld2 = $c2->{CPU_LOAD}->{$cpu};
672*d3c97224SAlexander Kolbasov
673*d3c97224SAlexander Kolbasov	if ($ld1 && $ld2) {
674*d3c97224SAlexander Kolbasov		$idle = $ld2->{cpu_idle} - $ld1->{cpu_idle};
675*d3c97224SAlexander Kolbasov		$user = $ld2->{cpu_user} - $ld1->{cpu_user};
676*d3c97224SAlexander Kolbasov		$sys  = $ld2->{cpu_sys}  - $ld1->{cpu_sys};
677*d3c97224SAlexander Kolbasov
678*d3c97224SAlexander Kolbasov		$swtotal = $idle + $user + $sys;
679*d3c97224SAlexander Kolbasov
680*d3c97224SAlexander Kolbasov		# Prevent division by zero
681*d3c97224SAlexander Kolbasov		$swtotal = 1 unless $swtotal;
682*d3c97224SAlexander Kolbasov
683*d3c97224SAlexander Kolbasov		$swload = ($user + $sys) * 100 / $swtotal;
684*d3c97224SAlexander Kolbasov		$idle   = $idle * 100 / $swtotal;
685*d3c97224SAlexander Kolbasov		$user   = $user * 100 / $swtotal;
686*d3c97224SAlexander Kolbasov		$sys    = $sys  * 100 / $swtotal;
687*d3c97224SAlexander Kolbasov	}
688*d3c97224SAlexander Kolbasov
689*d3c97224SAlexander Kolbasov	return (wantarray() ?
690*d3c97224SAlexander Kolbasov		($utilization, $accuracy, $hw_utilization,
691*d3c97224SAlexander Kolbasov		 $swload, $user, $sys, $idle) :
692*d3c97224SAlexander Kolbasov		$utilization);
693*d3c97224SAlexander Kolbasov}
694*d3c97224SAlexander Kolbasov
695*d3c97224SAlexander Kolbasov#
696*d3c97224SAlexander Kolbasov# online_cpus(kstat)
697*d3c97224SAlexander Kolbasov# Return list of on-line CPUs
698*d3c97224SAlexander Kolbasov#
699*d3c97224SAlexander Kolbasovsub online_cpus
700*d3c97224SAlexander Kolbasov{
701*d3c97224SAlexander Kolbasov	scalar @_ == 1 or _usage("online_cpus(cookie)");
702*d3c97224SAlexander Kolbasov
703*d3c97224SAlexander Kolbasov	my $self = shift or return;
704*d3c97224SAlexander Kolbasov	my $ks = $self->{KSTAT} or return;
705*d3c97224SAlexander Kolbasov
706*d3c97224SAlexander Kolbasov	my $cpu_info = $ks->{cpu_info} or return;
707*d3c97224SAlexander Kolbasov
708*d3c97224SAlexander Kolbasov	my @cpus = grep {
709*d3c97224SAlexander Kolbasov		my $cp = $cpu_info->{$_}->{"cpu_info$_"};
710*d3c97224SAlexander Kolbasov		my $state = $cp->{state};
711*d3c97224SAlexander Kolbasov		$state eq 'on-line' || $state eq 'no-intr';
712*d3c97224SAlexander Kolbasov	} keys %{$cpu_info};
713*d3c97224SAlexander Kolbasov
714*d3c97224SAlexander Kolbasov	return (wantarray() ? @cpus : _nsort(@cpus));
715*d3c97224SAlexander Kolbasov}
716*d3c97224SAlexander Kolbasov
717*d3c97224SAlexander Kolbasov#
718*d3c97224SAlexander Kolbasov# Support methods
719*d3c97224SAlexander Kolbasov#
720*d3c97224SAlexander Kolbasov# The following methods are not PG specific but are generally useful for PG
721*d3c97224SAlexander Kolbasov# interface consumers
722*d3c97224SAlexander Kolbasov#
723*d3c97224SAlexander Kolbasov
724*d3c97224SAlexander Kolbasov#
725*d3c97224SAlexander Kolbasov# Sort the list numerically
726*d3c97224SAlexander Kolbasov#
727*d3c97224SAlexander Kolbasovsub nsort
728*d3c97224SAlexander Kolbasov{
729*d3c97224SAlexander Kolbasov	scalar @_ > 0 or _usage("nsort(cookie, val, ...)");
730*d3c97224SAlexander Kolbasov	shift;
731*d3c97224SAlexander Kolbasov
732*d3c97224SAlexander Kolbasov	return (_nsort(@_));
733*d3c97224SAlexander Kolbasov}
734*d3c97224SAlexander Kolbasov
735*d3c97224SAlexander Kolbasov#
736*d3c97224SAlexander Kolbasov# Return the input list with duplicates removed.
737*d3c97224SAlexander Kolbasov# Should be used in list context
738*d3c97224SAlexander Kolbasov#
739*d3c97224SAlexander Kolbasovsub uniq
740*d3c97224SAlexander Kolbasov{
741*d3c97224SAlexander Kolbasov	scalar @_ > 0 or _usage("uniq(cookie, val, ...)");
742*d3c97224SAlexander Kolbasov	shift;
743*d3c97224SAlexander Kolbasov
744*d3c97224SAlexander Kolbasov	return (_uniq(@_));
745*d3c97224SAlexander Kolbasov}
746*d3c97224SAlexander Kolbasov
747*d3c97224SAlexander Kolbasov#
748*d3c97224SAlexander Kolbasov# Sort list numerically and remove duplicates
749*d3c97224SAlexander Kolbasov# Should be called in list context
750*d3c97224SAlexander Kolbasov#
751*d3c97224SAlexander Kolbasovsub uniqsort
752*d3c97224SAlexander Kolbasov{
753*d3c97224SAlexander Kolbasov	scalar @_ > 0 or _usage("uniqsort(cookie, val, ...)");
754*d3c97224SAlexander Kolbasov	shift;
755*d3c97224SAlexander Kolbasov
756*d3c97224SAlexander Kolbasov	return (_uniqsort(@_));
757*d3c97224SAlexander Kolbasov}
758*d3c97224SAlexander Kolbasov
759*d3c97224SAlexander Kolbasov
760*d3c97224SAlexander Kolbasov#
761*d3c97224SAlexander Kolbasov# Expand all arguments and present them as a numerically sorted list
762*d3c97224SAlexander Kolbasov# x,y is expanded as (x y)
763*d3c97224SAlexander Kolbasov# 1-3 ranges are expandes as (1 2 3)
764*d3c97224SAlexander Kolbasov#
765*d3c97224SAlexander Kolbasovsub expand
766*d3c97224SAlexander Kolbasov{
767*d3c97224SAlexander Kolbasov	scalar @_ > 0 or _usage("expand(cookie, val, ...)");
768*d3c97224SAlexander Kolbasov	shift;
769*d3c97224SAlexander Kolbasov
770*d3c97224SAlexander Kolbasov	return (_uniqsort(map { _expand($_) } @_));
771*d3c97224SAlexander Kolbasov}
772*d3c97224SAlexander Kolbasov
773*d3c97224SAlexander Kolbasov#
774*d3c97224SAlexander Kolbasov# Consolidate consecutive ids as start-end
775*d3c97224SAlexander Kolbasov# Input: list of ids
776*d3c97224SAlexander Kolbasov# Output: string with space-sepated cpu values with ranges
777*d3c97224SAlexander Kolbasov#   collapsed as x-y
778*d3c97224SAlexander Kolbasov#
779*d3c97224SAlexander Kolbasovsub id_collapse
780*d3c97224SAlexander Kolbasov{
781*d3c97224SAlexander Kolbasov	scalar @_ > 0 or _usage("collapse(cookie, val, ...)");
782*d3c97224SAlexander Kolbasov	shift;
783*d3c97224SAlexander Kolbasov
784*d3c97224SAlexander Kolbasov	return _collapse(@_);
785*d3c97224SAlexander Kolbasov}
786*d3c97224SAlexander Kolbasov
787*d3c97224SAlexander Kolbasov#
788*d3c97224SAlexander Kolbasov# Return elements of the second list not present in the first list. Both lists
789*d3c97224SAlexander Kolbasov# are passed by reference.
790*d3c97224SAlexander Kolbasov#
791*d3c97224SAlexander Kolbasovsub set_subtract
792*d3c97224SAlexander Kolbasov{
793*d3c97224SAlexander Kolbasov	scalar @_ == 3 or _usage("set_subtract(cookie, left, right)");
794*d3c97224SAlexander Kolbasov	shift;
795*d3c97224SAlexander Kolbasov
796*d3c97224SAlexander Kolbasov	return (_set_subtract(@_));
797*d3c97224SAlexander Kolbasov}
798*d3c97224SAlexander Kolbasov
799*d3c97224SAlexander Kolbasov#
800*d3c97224SAlexander Kolbasov# Return the intersection of two lists passed by reference
801*d3c97224SAlexander Kolbasov# Convert the first list to a hash with seen entries marked as 1-values
802*d3c97224SAlexander Kolbasov# Then grep only elements present in the first list from the second list.
803*d3c97224SAlexander Kolbasov# As a little optimization, use the shorter list to build a hash.
804*d3c97224SAlexander Kolbasov#
805*d3c97224SAlexander Kolbasovsub intersect
806*d3c97224SAlexander Kolbasov{
807*d3c97224SAlexander Kolbasov	scalar @_ == 3 or _usage("intersect(cookie, left, right)");
808*d3c97224SAlexander Kolbasov	shift;
809*d3c97224SAlexander Kolbasov
810*d3c97224SAlexander Kolbasov	return (_set_intersect(@_));
811*d3c97224SAlexander Kolbasov}
812*d3c97224SAlexander Kolbasov
813*d3c97224SAlexander Kolbasov#
814*d3c97224SAlexander Kolbasov# Return elements of the second list not present in the first list. Both lists
815*d3c97224SAlexander Kolbasov# are passed by reference.
816*d3c97224SAlexander Kolbasov#
817*d3c97224SAlexander Kolbasovsub _set_subtract
818*d3c97224SAlexander Kolbasov{