xref: /titanic_44/usr/src/cmd/lgrpinfo/lgrpinfo.pl (revision d2ec54f7875f7e05edd56195adbeb593c947763f) 
1#! /usr/perl5/bin/perl
2#
3# CDDL HEADER START
4#
5# The contents of this file are subject to the terms of the
6# Common Development and Distribution License (the "License").
7# You may not use this file except in compliance with the License.
8#
9# You can obtain a copy of the license at usr/src/OPENSOLARIS.LICENSE
10# or http://www.opensolaris.org/os/licensing.
11# See the License for the specific language governing permissions
12# and limitations under the License.
13#
14# When distributing Covered Code, include this CDDL HEADER in each
15# file and include the License file at usr/src/OPENSOLARIS.LICENSE.
16# If applicable, add the following below this CDDL HEADER, with the
17# fields enclosed by brackets "[]" replaced with your own identifying
18# information: Portions Copyright [yyyy] [name of copyright owner]
19#
20# CDDL HEADER END
21#
22
23#
24# Copyright 2006 Sun Microsystems, Inc.  All rights reserved.
25# Use is subject to license terms.
26#
27# ident	"%Z%%M%	%I%	%E% SMI"
28#
29
30#
31# lgrpinfo: display information about locality groups.
32#
33
34require 5.6.1;
35use warnings;
36use strict;
37use Getopt::Long qw(:config no_ignore_case bundling auto_version);
38use File::Basename;
39# Sun::Solaris::Kstat is used to extract per-lgroup load average.
40use Sun::Solaris::Kstat;
41use POSIX qw(locale_h);
42use Sun::Solaris::Utils qw(textdomain gettext);
43use Sun::Solaris::Lgrp ':CONSTANTS';
44
45use constant KB => 1024;
46
47#
48# Amount of load contributed by a single thread. The value is exported by the
49# kernel in the 'loadscale' variable of lgroup kstat, but in case it is missing
50# we use the current default value as the best guess.
51#
52use constant LGRP_LOADAVG_THREAD_MAX => 65516;
53
54# Get script name
55our $cmdname = basename($0, ".pl");
56
57# Get liblgrp version
58my $version = Sun::Solaris::Lgrp::lgrp_version();
59
60our $VERSION = "%I% (liblgrp version $version)";
61
62# The $loads hash keeps per-lgroup load average.
63our $loads = {};
64
65########################################
66# Main body
67##
68
69# Set message locale
70setlocale(LC_ALL, "");
71textdomain(TEXT_DOMAIN);
72
73# Parse command-line options
74our($opt_a, $opt_l, $opt_m, $opt_c, $opt_C, $opt_e, $opt_t, $opt_h, $opt_u,
75    $opt_r, $opt_L, $opt_P, $opt_I, $opt_T, $opt_G);
76
77GetOptions("a"   => \$opt_a,
78	   "c"   => \$opt_c,
79	   "C"	 => \$opt_C,
80	   "e"	 => \$opt_e,
81	   "G"	 => \$opt_G,
82	   "h|?" => \$opt_h,
83	   "l"   => \$opt_l,
84	   "L"	 => \$opt_L,
85	   "I"   => \$opt_I,
86	   "m"   => \$opt_m,
87	   "r"   => \$opt_r,
88	   "t"	 => \$opt_t,
89	   "T"   => \$opt_T,
90	   "u=s" => \$opt_u,
91	   "P"   => \$opt_P) || usage(3);
92
93usage(0) if $opt_h;
94
95# Check for conflicting options
96my $nfilters = 0;
97$nfilters++ if $opt_C;
98$nfilters++ if $opt_P;
99$nfilters++ if $opt_T;
100
101if ($nfilters > 1) {
102	printf STDERR
103	  gettext("%s: Options -C, -T and -P can not be used together\n"),
104	    $cmdname;
105	usage(3);
106}
107
108if ($opt_T && ($opt_I || $opt_t)) {
109	printf STDERR
110	  gettext("%s: Option -T can not be used with -I, -t\n"),
111	    $cmdname;
112	usage(3);
113}
114
115if ($opt_T && scalar @ARGV) {
116	printf STDERR
117	  gettext("%s: Warning: with '-T' all lgroups on the command line "),
118	    $cmdname;
119	printf STDERR gettext("are ignored\n\n");
120}
121
122if ($opt_L && $opt_I) {
123	printf STDERR gettext("%s: Option -I can not be used with -L\n"),
124	  $cmdname;
125	usage(3);
126}
127
128# Figure out what to do based on options
129my $do_default = 1 unless
130  $opt_a || $opt_l || $opt_m || $opt_c || $opt_e || $opt_t || $opt_r;
131
132
133my $l =  Sun::Solaris::Lgrp->new($opt_G ? LGRP_VIEW_OS : LGRP_VIEW_CALLER) or
134    die(gettext("$cmdname: can not get lgroup information from the system\n"));
135
136
137# Get list of all lgroups, the root and the list of intermediates
138my @lgrps = nsort($l->lgrps);
139my $root = $l->root;
140my @intermediates = grep { $_ != $root && !$l->isleaf($_) } @lgrps;
141my $is_uma = (scalar @lgrps == 1);
142
143# Print everything if -a is specified or it is default without -T
144my $do_all    = 1 if $opt_a  || ($do_default && !($opt_T || $opt_L));
145
146# Print individual information if do_all or requested specific print
147my $do_lat    = 1 if $do_all || $opt_l;
148my $do_memory = 1 if $do_all || $opt_m;
149my $do_cpu    = 1 if $do_all || $opt_c;
150my $do_topo   = 1 if $do_all || $opt_t;
151my $do_rsrc   = 1 if $do_all || $opt_r;
152my $do_load   = 1 if $do_all || $opt_e;
153my $do_table  = 1 if $opt_a  || $opt_L;
154my $do_something = ($do_lat || $do_memory || $do_cpu || $do_topo ||
155		    $do_rsrc || $do_load);
156
157# Does the liblgrp(3LIB) has enough capabilities to support resource view?
158if ($do_rsrc && LGRP_VER_CURRENT == 1) {
159	if ($opt_r) {
160		printf STDERR
161		  gettext("%s: sorry, your system does not support"),
162		    $cmdname;
163		printf STDERR " lgrp_resources(3LGRP)\n";
164	}
165	$do_rsrc = 0;
166}
167
168# Get list of lgrps from arguments, expanding symbolic names like
169# "root" and "leaves"
170# Use all lgroups if none are specified on the command line
171my @lgrp_list = (scalar (@ARGV) && !$opt_T) ? lgrp_expand($l, @ARGV) : @lgrps;
172
173# Apply 'Parent' or 'Children' operations if requested
174@lgrp_list = map { $l->parents($_)  } @lgrp_list if $opt_P;
175@lgrp_list = map { $l->children($_) } @lgrp_list if $opt_C;
176
177# Drop repeating elements and sort lgroups numerically.
178@lgrp_list = uniqsort(@lgrp_list);
179
180# If both -L and -c are specified, just print list of CPUs.
181if ($opt_c && $opt_I) {
182	my @cpus = uniqsort(map { $l->cpus($_, LGRP_CONTENT_HIERARCHY) }
183			    @lgrp_list);
184	print "@cpus\n";
185	exit(0);
186}
187
188my $unit_str = "K";
189my $units = KB;
190
191# Convert units to canonical numeric and string formats.
192if ($opt_u) {
193	if ($opt_u =~ /^b$/i) {
194		$units = 1;
195		$unit_str = "B";
196	} elsif ($opt_u =~ /^k$/i) {
197		$units = KB;
198		$unit_str = "K";
199	} elsif ($opt_u =~ /^m$/i) {
200		$units = KB * KB;
201		$unit_str = "M";
202	} elsif ($opt_u =~ /^g$/i) {
203		$units = KB * KB * KB;
204		$unit_str = "G";
205	} elsif ($opt_u =~ /^t$/i) {
206		$units = KB * KB * KB * KB;
207		$unit_str = "T";
208	} elsif ($opt_u =~ /^p$/i) {
209		$units = KB * KB * KB * KB * KB;
210		$unit_str = "P";
211	} elsif ($opt_u =~ /^e$/i) {
212		$units = KB * KB * KB * KB * KB * KB;
213		$unit_str = "E";
214	} elsif (! ($opt_u =~ /^m$/i)) {
215		printf STDERR
216		  gettext("%s: invalid unit '$opt_u', should be [b|k|m|g|t|p|e]"),
217		    $cmdname;
218		printf STDERR gettext(", using the default.\n\n");
219		$opt_u = 0;
220	}
221}
222
223# Collect load average data if requested.
224$loads = get_lav() if $do_load;
225
226# Get latency values for each lgroup.
227my %self_latencies;
228map { $self_latencies{$_} = $l->latency($_, $_) } @lgrps;
229
230# If -T is specified, just print topology and return.
231if ($opt_T) {
232	lgrp_prettyprint($l);
233	print_latency_table(\@lgrps, \@lgrps) if $do_table;
234	exit(0);
235}
236
237if (!scalar @lgrp_list) {
238	printf STDERR gettext("%s: No matching lgroups found!\n"), $cmdname;
239	exit(2);
240}
241
242# Just print list of lgrps if doing just filtering
243(print "@lgrp_list\n"), exit 0 if $opt_I;
244
245if ($do_something) {
246	# Walk through each requested lgrp and print whatever is requested.
247	foreach my $lgrp (@lgrp_list) {
248		my $is_leaf = $l->isleaf($lgrp);
249		my ($children, $parents, $cpus, $memstr, $rsrc);
250
251		my $prefix = ($lgrp == $root) ?
252		  "root": $is_leaf ? gettext("leaf") : gettext("intermediate");
253		printf gettext("lgroup %d (%s):"), $lgrp, $prefix;
254
255		if ($do_topo) {
256			# Get children of this lgrp.
257			my @children = $l->children($lgrp);
258			$children = $is_leaf ?
259			  gettext("Children: none") :
260			    gettext("Children: ") . lgrp_collapse(@children);
261			# Are there any parents for this lgrp?
262			my @parents = $l->parents($lgrp);
263			$parents = @parents ?
264			  gettext(", Parent: ") . "@parents" :
265			    "";
266		}
267
268		if ($do_cpu) {
269			$cpus = lgrp_showcpus($lgrp, LGRP_CONTENT_HIERARCHY);
270		}
271		if ($do_memory) {
272			$memstr = lgrp_showmemory($lgrp, LGRP_CONTENT_HIERARCHY);
273		}
274		if ($do_rsrc) {
275			$rsrc = lgrp_showresources($lgrp);
276		}
277
278		# Print all the information about lgrp.
279		print "\n\t$children$parents"	if $do_topo;
280		print "\n\t$cpus"		if $do_cpu && $cpus;
281		print "\n\t$memstr"		if $do_memory && $memstr;
282		print "\n\t$rsrc"		if $do_rsrc;
283		print "\n\t$loads->{$lgrp}"	if defined ($loads->{$lgrp});
284		if ($do_lat && defined($self_latencies{$lgrp})) {
285		    printf gettext("\n\tLatency: %d"), $self_latencies{$lgrp};
286		}
287		print "\n";
288	}
289}
290
291print_latency_table(\@lgrps, \@lgrp_list) if $do_table;
292
293exit 0;
294
295#
296# usage(exit_status)
297# print usage message and exit with the specified exit status.
298#
299sub usage
300{
301	printf STDERR gettext("Usage:\t%s"), $cmdname;
302	print STDERR " [-aceGlLmrt] [-u unit] [-C|-P] [lgrp] ...\n";
303	print STDERR "      \t$cmdname -I [-c] [-G] [-C|-P] [lgrp] ...\n";
304	print STDERR "      \t$cmdname -T [-aceGlLmr] [-u unit]\n";
305	print STDERR "      \t$cmdname -h\n\n";
306
307	printf STDERR
308	  gettext("   Display information about locality groups\n\n" .
309		  "\t-a: Equivalent to \"%s\" without -T and to \"%s\" with -T\n"),
310		    "-celLmrt", "-celLmr";
311
312	print STDERR
313	  gettext("\t-c: Print CPU information\n"),
314	  gettext("\t-C: Children of the specified lgroups\n"),
315	  gettext("\t-e: Print lgroup load average\n"),
316	  gettext("\t-h: Print this message and exit\n"),
317	  gettext("\t-I: Print lgroup or CPU IDs only\n"),
318	  gettext("\t-l: Print information about lgroup latencies\n"),
319	  gettext("\t-G: Print OS view of lgroup hierarchy\n"),
320	  gettext("\t-L: Print lgroup latency table\n"),
321	  gettext("\t-m: Print memory information\n"),
322	  gettext("\t-P: Parent(s) of the specified lgroups\n"),
323	  gettext("\t-r: Print lgroup resources\n"),
324	  gettext("\t-t: Print information about lgroup topology\n"),
325	  gettext("\t-T: Print the hierarchy tree\n"),
326	  gettext("\t-u unit: Specify memory unit (b,k,m,g,t,p,e)\n\n\n");
327
328	print STDERR
329	  gettext("    The lgrp may be specified as an lgroup ID,"),
330	  gettext(" \"root\", \"all\",\n"),
331	  gettext("    \"intermediate\" or \"leaves\".\n\n");
332
333	printf STDERR
334	  gettext("    The default set of options is \"%s\"\n\n"),
335	    "-celmrt all";
336
337	print STDERR
338	  gettext("    Without any options print topology, CPU and memory " .
339		  "information about each\n" .
340		  "    lgroup. If any lgroup IDs are specified on the " .
341		  "command line only print\n" .
342		  "    information about the specified lgroup.\n\n");
343
344	exit(shift);
345}
346
347# Return the input list with duplicates removed.
348sub uniq
349{
350	my %seen;
351	return (grep { ++$seen{$_} == 1 } @_);
352}
353
354#
355# Sort the list numerically
356# Should be called in list context
357#
358sub nsort
359{
360	return (sort { $a <=> $b } @_);
361}
362
363#
364# Sort list numerically and remove duplicates
365# Should be called in list context
366#
367sub uniqsort
368{
369	return (sort { $a <=> $b } uniq(@_));
370}
371
372# Round values
373sub round
374{
375	my $val = shift;
376
377	return (int($val + 0.5));
378}
379
380#
381# Expand list of lgrps.
382# 	Translate 'root' to the root lgrp id
383# 	Translate 'all' to the list of all lgrps
384# 	Translate 'leaves' to the list of all lgrps'
385#	Translate 'intermediate' to the list of intermediates.
386#
387sub lgrp_expand
388{
389	my $lobj = shift;
390	my %seen;
391	my @result;
392
393	# create a hash element for every element in @lgrps
394	map { $seen{$_}++ } @lgrps;
395
396	foreach my $lgrp (@_) {
397		push(@result, $lobj->root),   next if $lgrp =~ m/^root$/i;
398		push(@result, @lgrps),	      next if $lgrp =~ m/^all$/i;
399		push(@result, $lobj->leaves), next if $lgrp =~ m/^leaves$/i;
400		push(@result, @intermediates),
401		  next if $lgrp =~ m/^intermediate$/i;
402		push(@result, $lgrp),
403		  next if $lgrp =~ m/^\d+$/ && $seen{$lgrp};
404		printf STDERR gettext("%s: skipping invalid lgrp $lgrp\n"),
405		  $cmdname;
406	}
407
408	return @result;
409}
410
411#
412# lgrp_tree(class, node)
413#
414# Build the tree of the lgroup hierarchy starting with the specified node or
415# root if no initial node is specified. Calls itself recursively specifying each
416# of the children as a starting node. Builds a reference to the list with the
417# node in the end and each element being a subtree.
418#
419sub lgrp_tree
420{
421	my $c = shift;
422	my $lgrp = shift || $c->root;
423
424	# Call itself for each of the children and combine results in a list.
425	[ (map { lgrp_tree($c, $_) } $c->children($lgrp)), $lgrp ];
426}
427
428#
429# lgrp_pp(tree, prefix, childprefix, npeers)
430#
431# pretty-print the hierarchy tree.
432# Input Arguments:
433#	Reference to the tree
434#	Prefix for me to use
435#	Prefix for my children to use
436#	Number of peers left
437#
438sub lgrp_pp
439{
440	my $tree = shift;
441	my $myprefix = shift;
442	my $childprefix = shift;
443	my $npeers = shift;
444	my $el = pop @$tree;
445	my $nchildren = scalar @$tree;
446	my $printprefix = "$childprefix";
447	my $printpostfix = $npeers ? "|   " : "    ";
448
449	return unless defined ($el);
450
451	my $bar = $npeers ? "|" : "`";
452	print $childprefix ? $childprefix : "";
453	print $myprefix ? "$bar" . "-- " : "";
454	lgrp_print($el, "$printprefix$printpostfix");
455
456	my $new_prefix = $npeers ? $myprefix : "    ";
457
458	# Pretty-print the subtree with a new offset.
459	map {
460		lgrp_pp($_, "|   ", "$childprefix$new_prefix", --$nchildren)
461	} @$tree;
462}
463
464# Pretty print the whole tree
465sub lgrp_prettyprint
466{
467	my $c = shift;
468	my $tree = lgrp_tree $c;
469	lgrp_pp($tree, '', '', scalar $tree - 1);
470}
471
472sub lgrp_print
473{
474	my $lgrp = shift;
475	my $prefix = shift;
476	my ($cpus, $memstr, $rsrc);
477	my $is_interm = ($lgrp != $root && !$l->isleaf($lgrp));
478	my $not_root = $is_uma || $lgrp != $root;
479
480	print "$lgrp";
481
482	if ($do_cpu && $not_root) {
483		$cpus   = lgrp_showcpus($lgrp, LGRP_CONTENT_HIERARCHY);
484	}
485	if ($do_memory && $not_root) {
486		$memstr = lgrp_showmemory($lgrp, LGRP_CONTENT_HIERARCHY);
487	}
488	if ($do_rsrc && ($is_uma || $is_interm)) {
489		$rsrc   = lgrp_showresources($lgrp) if $do_rsrc;
490	}
491
492	# Print all the information about lgrp.
493
494	print "\n$prefix$cpus"		if $cpus;
495	print "\n$prefix$memstr"	if $memstr;
496	print "\n$prefix$rsrc"		if $rsrc;
497	print "\n$prefix$loads->{$lgrp}"	if defined ($loads->{$lgrp});
498
499	# Print latency information if requested.
500	if ($do_lat && $lgrp != $root && defined($self_latencies{$lgrp})) {
501		print "\n${prefix}";
502		printf gettext("Latency: %d"), $self_latencies{$lgrp};
503	}
504	print "\n";
505}
506
507# What CPUs are in this lgrp?
508sub lgrp_showcpus
509{
510	my $lgrp = shift;
511	my $hier = shift;
512
513	my @cpus = $l->cpus($lgrp, $hier);
514	my $ncpus = @cpus;
515	return 0 unless $ncpus;
516	# Sort CPU list if there is something to sort.
517	@cpus = nsort(@cpus) if ($ncpus > 1);
518	my $cpu_string = lgrp_collapse(@cpus);
519	return (($ncpus == 1) ?
520		gettext("CPU: ") . $cpu_string:
521		gettext("CPUs: ") . $cpu_string);
522}
523
524# How much memory does this lgrp contain?
525sub lgrp_showmemory
526{
527	my $lgrp = shift;
528	my $hier = shift;
529
530	my $memory = $l->mem_size($lgrp, LGRP_MEM_SZ_INSTALLED, $hier);
531	return (0) unless $memory;
532	my $freemem = $l->mem_size($lgrp, LGRP_MEM_SZ_FREE, $hier) || 0;
533
534	my $memory_r = memory_to_string($memory);
535	my $freemem_r = memory_to_string($freemem);
536	my $usedmem = memory_to_string($memory - $freemem);
537
538	my $memstr = sprintf(gettext("Memory: installed %s"),
539			     $memory_r);
540	$memstr = $memstr . sprintf(gettext(", allocated %s"),
541				    $usedmem);
542	$memstr = $memstr . sprintf(gettext(", free %s"),
543				    $freemem_r);
544	return ($memstr);
545}
546
547# Get string containing lgroup resources
548sub lgrp_showresources
549{
550	my $lgrp = shift;
551	my $rsrc_prefix = gettext("Lgroup resources:");
552	# What resources does this lgroup contain?
553	my @resources_cpu = nsort($l->resources($lgrp, LGRP_RSRC_CPU));
554	my @resources_mem = nsort($l->resources($lgrp, LGRP_RSRC_MEM));
555	my $rsrc = @resources_cpu || @resources_mem ? "" : gettext("none");
556	$rsrc = $rsrc_prefix . $rsrc;
557	my $rsrc_cpu = lgrp_collapse(@resources_cpu);
558	my $rsrc_mem = lgrp_collapse(@resources_mem);
559	my $lcpu = gettext("CPU");
560	my $lmemory = gettext("memory");
561	$rsrc = "$rsrc $rsrc_cpu ($lcpu);" if scalar @resources_cpu;
562	$rsrc = "$rsrc $rsrc_mem ($lmemory)" if scalar @resources_mem;
563	return ($rsrc);
564}
565
566#
567# Consolidate consequtive ids as start-end
568# Input: list of ids
569# Output: string with space-sepated cpu values with ranges
570#   collapsed as x-y
571#
572sub lgrp_collapse
573{
574	return ('') unless @_;
575	my @args = uniqsort(@_);
576	my $start = shift(@args);
577	my $result = '';
578	my $end = $start;	# Initial range consists of the first element
579	foreach my $el (@args) {
580		if ($el == ($end + 1)) {
581			#
582			# Got consecutive ID, so extend end of range without
583			# printing anything since the range may extend further
584			#
585			$end = $el;
586		} else {
587			#
588			# Next ID is not consecutive, so print IDs gotten so
589			# far.
590			#
591			if ($end > $start + 1) {	# range
592				$result = "$result $start-$end";
593			} elsif ($end > $start) {	# different values
594				$result = "$result $start $end";
595			} else {	# same value
596				$result = "$result $start";
597			}
598
599			# Try finding consecutive range starting from this ID
600			$start = $end = $el;
601		}
602	}
603
604	# Print last ID(s)
605	if ($end > $start + 1) {
606		$result = "$result $start-$end";
607	} elsif ($end > $start) {
608		$result = "$result $start $end";
609	} else {
610		$result = "$result $start";
611	}
612	# Remove any spaces in the beginning
613	$result =~ s/^\s+//;
614	return ($result);
615}
616
617# Print latency information if requested and the system has several lgroups.
618sub print_latency_table
619{
620	my ($lgrps1, $lgrps2) = @_;
621
622	return unless scalar @lgrps;
623
624	# Find maximum lgroup
625	my $max = $root;
626	map { $max = $_ if $max < $_ } @$lgrps1;
627
628	# Field width for lgroup - the width of the largest lgroup and 1 space
629	my $lgwidth = length($max) + 1;
630	# Field width for latency. Get the maximum latency and add 1 space.
631	my $width = length($l->latency($root, $root)) + 1;
632	# Make sure that width is enough to print lgroup itself.
633	$width = $lgwidth if $width < $lgwidth;
634
635	# Print table header
636	print gettext("\nLgroup latencies:\n");
637	# Print horizontal line
638	print "\n", "-" x ($lgwidth + 1);
639	map { print '-' x $width } @$lgrps1;
640	print "\n", " " x $lgwidth, "|";
641	map { printf("%${width}d", $_) } @$lgrps1;
642	print "\n", "-" x ($lgwidth + 1);
643	map { print '-' x $width } @$lgrps1;
644	print "\n";
645
646	# Print the latency table
647	foreach my $l1 (@$lgrps2) {
648		printf "%-${lgwidth}d|", $l1;
649		foreach my $l2 (@lgrps) {
650			my $latency = $l->latency($l1, $l2);
651			if (!defined ($latency)) {
652				printf "%${width}s", "-";
653			} else {
654				printf "%${width}d", $latency;
655			}
656		}
657		print "\n";
658	}
659
660	# Print table footer
661	print "-" x ($lgwidth + 1);
662	map { print '-' x $width } @lgrps;
663	print "\n";
664}
665
666#
667# Convert a number to a string representation
668# The number is scaled down until it is small enough to be in a good
669# human readable format i.e. in the range 0 thru 1023.
670# If it's smaller than 10 there's room enough to provide one decimal place.
671#
672sub number_to_scaled_string
673{
674	my $number = shift;
675
676	my $scale = KB;
677	my @measurement = ('K', 'M', 'G', 'T', 'P', 'E');	# Measurement
678	my $uom = shift(@measurement);
679	my $result;
680
681	# Get size in K.
682	$number /= KB;
683
684	my $save = $number;
685	while (($number >= $scale) && $uom ne 'E') {
686		$uom = shift(@measurement);
687		$save = $number;
688		$number = ($number + ($scale / 2)) / $scale;
689	}
690
691	# check if we should output a decimal place after the point
692	if ($save && (($save / $scale) < 10)) {
693		$result = sprintf("%2.1f", $save / $scale);
694	} else {
695		$result = round($number);
696	}
697	return ("$result$uom");
698}
699
700#
701# Convert memory size to the string representation
702#
703sub memory_to_string
704{
705	my $number = shift;
706
707	# Zero memory - just print 0
708	return ("0$unit_str") unless $number;
709
710	#
711	# Return memory size scaled to human-readable form unless -u is
712	# specified.
713	#
714	return (number_to_scaled_string($number)) unless $opt_u;
715
716	my $scaled = $number / $units;
717	my $result;
718
719	if ($scaled < 0.1) {
720		$result = sprintf("%2.1g", $scaled);
721	} elsif ($scaled < 10) {
722		$result = sprintf("%2.1f", $scaled);
723	} else {
724		$result = int($scaled + 0.5);
725	}
726	return ("$result$unit_str");
727}
728
729#
730# Read load averages from lgrp kstats Return hash reference indexed by lgroup ID
731# for each lgroup which has load information.
732#
733sub get_lav
734{
735	my $load = {};
736
737	my $ks = Sun::Solaris::Kstat->new(strip_strings => 1) or
738	  warn(gettext("$cmdname: kstat_open() failed: %!\n")),
739	    return $load;
740
741	my $lgrp_kstats = $ks->{lgrp} or
742	  warn(gettext("$cmdname: can not read lgrp kstat\n)")),
743	    return $load;
744
745	# Collect load for each lgroup
746	foreach my $i (keys %$lgrp_kstats) {
747		next unless $lgrp_kstats->{$i}->{"lgrp$i"};
748		my $lav = $lgrp_kstats->{$i}->{"lgrp$i"}->{"load average"};
749		# Skip this lgroup if can't find its load average
750		next unless defined $lav;
751		my $scale = $lgrp_kstats->{$i}->{"lgrp$i"}->{"loadscale"} ||
752			LGRP_LOADAVG_THREAD_MAX;
753		$load->{$i} = sprintf (gettext("Load: %4.3g"), $lav / $scale);
754	}
755	return $load;
756}
757