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