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# 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 my $save = $number; 682 683 # Get size in K. 684 $number /= KB; 685 686 while (($number >= $scale) && $uom ne 'E') { 687 $uom = shift(@measurement); 688 $save = $number; 689 $number /= $scale; 690 } 691 692 # check if we should output a decimal place after the point 693 if ($save && (($save / $scale) < 10)) { 694 $result = sprintf("%2.1f", $save / $scale); 695 } else { 696 $result = round($number); 697 } 698 return ("$result$uom"); 699} 700 701# 702# Convert memory size to the string representation 703# 704sub memory_to_string 705{ 706 my $number = shift; 707 708 # Zero memory - just print 0 709 return ("0$unit_str") unless $number; 710 711 # 712 # Return memory size scaled to human-readable form unless -u is 713 # specified. 714 # 715 return (number_to_scaled_string($number)) unless $opt_u; 716 717 my $scaled = $number / $units; 718 my $result; 719 720 if ($scaled < 0.1) { 721 $result = sprintf("%2.1g", $scaled); 722 } elsif ($scaled < 10) { 723 $result = sprintf("%2.1f", $scaled); 724 } else { 725 $result = int($scaled + 0.5); 726 } 727 return ("$result$unit_str"); 728} 729 730# 731# Read load averages from lgrp kstats Return hash reference indexed by lgroup ID 732# for each lgroup which has load information. 733# 734sub get_lav 735{ 736 my $load = {}; 737 738 my $ks = Sun::Solaris::Kstat->new(strip_strings => 1) or 739 warn(gettext("$cmdname: kstat_open() failed: %!\n")), 740 return $load; 741 742 my $lgrp_kstats = $ks->{lgrp} or 743 warn(gettext("$cmdname: can not read lgrp kstat\n)")), 744 return $load; 745 746 # Collect load for each lgroup 747 foreach my $i (keys %$lgrp_kstats) { 748 next unless $lgrp_kstats->{$i}->{"lgrp$i"}; 749 my $lav = $lgrp_kstats->{$i}->{"lgrp$i"}->{"load average"}; 750 # Skip this lgroup if can't find its load average 751 next unless defined $lav; 752 my $scale = $lgrp_kstats->{$i}->{"lgrp$i"}->{"loadscale"} || 753 LGRP_LOADAVG_THREAD_MAX; 754 $load->{$i} = sprintf (gettext("Load: %4.3g"), $lav / $scale); 755 } 756 return $load; 757} 758