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