usr/src/cmd/lgrpinfo/lgrpinfo.pl

   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
  32 require 5.8.4;
  33 use warnings;
  34 use strict;
  35 use Getopt::Long qw(:config no_ignore_case bundling auto_version);
  36 use File::Basename;
  37 # Sun::Solaris::Kstat is used to extract per-lgroup load average.
  38 use Sun::Solaris::Kstat;
  39 use POSIX qw(locale_h);
  40 use Sun::Solaris::Utils qw(textdomain gettext);
  41 use Sun::Solaris::Lgrp ':CONSTANTS';
  42
  43 use 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 #
  50 use constant LGRP_LOADAVG_THREAD_MAX => 65516;
  51
  52 # Get script name
  53 our $cmdname = basename($0, ".pl");
  54
  55 # Get liblgrp version
  56 my $version = Sun::Solaris::Lgrp::lgrp_version();
  57
  58 our $VERSION = "%I% (liblgrp version $version)";
  59
  60 # The $loads hash keeps per-lgroup load average.
  61 our $loads = {};
  62
  63 ########################################
  64 # Main body
  65 ##
  66
  67 # Set message locale
  68 setlocale(LC_ALL, "");
  69 textdomain(TEXT_DOMAIN);
  70
  71 # Parse command-line options
  72 our($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
  75 GetOptions("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
  91 usage(0) if $opt_h;
  92
  93 # Check for conflicting options
  94 my $nfilters = 0;
  95 $nfilters++ if $opt_C;
  96 $nfilters++ if $opt_P;
  97 $nfilters++ if $opt_T;
  98
  99 if ($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
 106 if ($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
 113 if ($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
 120 if ($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
 127 my $do_default = 1 unless
 128   $opt_a || $opt_l || $opt_m || $opt_c || $opt_e || $opt_t || $opt_r;
 129
 130
 131 my $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
 136 my @lgrps = nsort($l->lgrps);
 137 my $root = $l->root;
 138 my @intermediates = grep { $_ != $root && !$l->isleaf($_) } @lgrps;
 139 my $is_uma = (scalar @lgrps == 1);
 140
 141 # Print everything if -a is specified or it is default without -T
 142 my $do_all    = 1 if $opt_a  || ($do_default && !($opt_T || $opt_L));
 143
 144 # Print individual information if do_all or requested specific print
 145 my $do_lat    = 1 if $do_all || $opt_l;
 146 my $do_memory = 1 if $do_all || $opt_m;
 147 my $do_cpu    = 1 if $do_all || $opt_c;
 148 my $do_topo   = 1 if $do_all || $opt_t;
 149 my $do_rsrc   = 1 if $do_all || $opt_r;
 150 my $do_load   = 1 if $do_all || $opt_e;
 151 my $do_table  = 1 if $opt_a  || $opt_L;
 152 my $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?
 156 if ($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
 169 my @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.
 179 if ($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
 186 my $unit_str = "K";
 187 my $units = KB;
 188
 189 # Convert units to canonical numeric and string formats.
 190 if ($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.
 225 my %self_latencies;
 226 map { $self_latencies{$_} = $l->latency($_, $_) } @lgrps;
 227
 228 # If -T is specified, just print topology and return.
 229 if ($opt_T) {
 230         lgrp_prettyprint($l);
 231         print_latency_table(\@lgrps, \@lgrps) if $do_table;
 232         exit(0);
 233 }
 234
 235 if (!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
 243 if ($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
 289 print_latency_table(\@lgrps, \@lgrp_list) if $do_table;
 290
 291 exit 0;
 292
 293 #
 294 # usage(exit_status)
 295 # print usage message and exit with the specified exit status.
 296 #
 297 sub 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.
 346 sub 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 #
 356 sub 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 #
 365 sub uniqsort
 366 {
 367         return (sort { $a <=> $b } uniq(@_));
 368 }
 369
 370 # Round values
 371 sub 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 #
 385 sub 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 #
 417 sub 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 #
 436 sub 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
 463 sub lgrp_prettyprint
 464 {
 465         my $c = shift;
 466         my $tree = lgrp_tree $c;
 467         lgrp_pp($tree, '', '', scalar $tree - 1);
 468 }
 469
 470 sub 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?
 506 sub 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?
 523 sub 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
 546 sub 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 #
 570 sub 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.
 616 sub 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 #
 670 sub 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 #
 702 sub 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 #
 732 sub 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 }