Hallo, dies ist ein Test.

PWD: /www/data-lst1/unixsoft/unixsoft/kaempfer/.public_html

Running in File Mode
Relative path: ./../../../../.././../sbin/psrinfo
Real path: /usr/sbin/psrinfo
Zurück

#!/usr/perl5/5.36/bin/perl -t

#
# Copyright (c) 1992, 2023, Oracle and/or its affiliates.
#
#
# psrinfo: displays information about processors
#
# See detailed comment in the end of this file.
#

use strict;
use warnings;
use locale;
use POSIX qw(locale_h strftime);
use File::Basename;
use Getopt::Long qw(:config no_ignore_case bundling auto_version);
use Sun::Solaris::Utils qw(textdomain gettext);
use Sun::Solaris::Kstat;
use Sun::Solaris::Lgrp qw(:CONSTANTS);

no warnings qw(taint);

# Set message locale
setlocale(LC_ALL, "");
textdomain("solaris_cmd_psrinfo");

######################################################################
# Configuration variables
######################################################################

# Regexp describing cpu_info kstat fields describing CPU hierarchy.
my $valid_id_exp = qr{^(?:chip|core)_id$};

# Translation of kstat name to human-readable form
my %translations = ('chip_id' => gettext("The physical processor"),
		    'core_id' => gettext("The core"));

# Localized version of plural forms
my %pluralized_names = ('processor'	=> gettext("processor"),
			'processors'	=> gettext("processors"),
			'chip'		=> gettext("chip"),
			'chips'		=> gettext("chips"),
			'core'		=> gettext("core"),
			'cores'		=> gettext("cores"));

# Localized CPU states
my %cpu_states = ('on-line'	=> gettext("on-line"),
		  'off-line'	=> gettext("off-line"),
		  'faulted'	=> gettext("faulted"),
		  'powered-off' => gettext("powered-off"),
		  'no-intr'	=> gettext("no-intr"),
		  'spare'	=> gettext("spare"),
		  'unknown'	=> gettext("unknown"));

######################################################################
# Global variables
######################################################################

# Hash with CPU ID as a key and specific per-cpu kstat hash as a value
our %cpu_list;

# Command name without path and trailing .pl - used for error messages.
our $cmdname = basename($0, ".pl");

# Return value
our $errors = 0;

######################################################################
# Helper subroutines
######################################################################

#
# Print help string if specified or the standard help message and exit setting
# errno.
#
sub usage
{
	my (@msg) = @_;
	print STDERR $cmdname, ": @msg\n" if (@msg);
	print STDERR gettext("usage: \n" .
			 "\tpsrinfo [-v] [-p] [processor_id ...]\n" .
			 "\tpsrinfo -s [-p] processor_id\n");
	exit(2);
}

#
# Return the input list with duplicates removed.
# Count how many times we've seen each element and remove elements seen more
# than once.
#
sub uniq
{
	my %seen;	# Have we seen this element already?
	return (grep { ++$seen{$_} == 1 } @_);
}

#
# Return the intersection of two lists passed by reference
# Convert the first list to a hash with seen entries marked as 1-values
# Then grep only elements present in the first list from the second list.
# As a little optimization, use the shorter list to build a hash.
#
sub intersect
{
	my ($left, $right) = @_;
	my %seen;	# Set to 1 for everything in the first list
	# Put the shortest list in $left
	scalar @$left <= scalar @$right or ($right, $left) = ($left, $right);

# Create a hash indexed by elements in @left with ones as a value.
	map { $seen{$_} = 1 } @$left;
	# Find members of @right present in @left
	return (grep { $seen{$_} } @$right);
}

#
# Return elements of the second list not present in the first list. Both lists
# are passed by reference.
#
sub set_subtract
{
	my ($left, $right) = @_;
	my %seen;	# Set to 1 for everything in the first list
	# Create a hash indexed by elements in @left with ones as a value.
	map { $seen{$_} = 1 } @$left;
	# Find members of @right present in @left
	return (grep { ! $seen{$_} } @$right);
}

#
# Returns 1 if set b is a subset of set a.  Sets are passed by reference.
#
sub subset
{
	my  ($a, $b) = @_;

my %amap = map { $_ => 1 } @$a;
	foreach my $i (@$b) {
		return 0 if (!$amap{$i});
	}
	return 1;	
}

#
# Sort the list numerically
# Should be called in list context
#
sub nsort
{
	return (sort { $a <=> $b } @_);
}

#
# Sort list numerically and remove duplicates
# Should be called in list context
#
sub uniqsort
{
	return (sort { $a <=> $b } uniq(@_));
}

#
# Return the maximum value of its arguments
#
sub max
{
	my $m = shift;

foreach my $el (@_) {
		$m = $el if $m < $el;
	}
	return ($m);
}

#
# Pluralize name if there is more than one instance
# Arguments: name, ninstances
#
sub pluralize
{
	my ($name, $count) = @_;
	# Remove trailing '_id' from the name.
	$name =~ s/_id$//;
	my $plural_name = $count > 1 ? "${name}s" : $name;
	return ($pluralized_names{$plural_name} || $plural_name)
}

#
# Translate id name into printable form
# Look at the %translations table and replace everything found there
# Remove trailing _id from the name if there is no translation
#
sub id_translate
{
	my $name = shift or return;
	my $translated_name = $translations{$name};
	$name =~ s/_id$// unless $translated_name;
	return ($translated_name || $name);
}

#
# Consolidate consequtive CPU ids as start-end
# Input: list of CPUs
# Output: string with space-sepated cpu values with CPU ranges
#   collapsed as x-y
#
sub collapse
{
	local $_ = join ',' => @_;
	s/(?<!\d)(\d+)(?:,((??{$++1}))(?!\d))+/$1-$+/g;
	return $_; 
}

#
# Expand start-end into the list of values
# Input: string containing a single numeric ID or x-y range
# Output: single value or a list of values
# Ranges with start being more than end are inverted
#
sub expand
{
	my $arg = shift;

if ($arg =~ m/^\d+$/) {
		# single number
		return ($_);
	} elsif ($arg =~ m/^(\d+)\-(\d+)$/) {
		my ($start, $end) = ($1, $2);	# $start-$end
		# Reverse the interval if start > end
		($start, $end) = ($end, $start) if $start > $end;
		return ($start .. $end);
	} elsif ($arg =~ m/-/) {
		printf STDERR
		  gettext("%s: invalid processor range %s\n"),
		    $cmdname, $_;
	} else {
		printf STDERR
		  gettext("%s: processor %s: Invalid argument\n"),
		    $cmdname, $_;
	}
	$errors = 2;
	return ();
}

#
# Functions for constructing CPU hierarchy. Only used with -vp option.
#

#
# Return numerically sorted list of distinct values of a given cpu_info kstat
# field, spanning given CPU set.
#
# Arguments:
#   Property name
#   list of CPUs
#
# Treat undefined values as zeroes.
sub property_list
{
	my $prop_name = shift;
	return (grep {$_ >= 0} uniqsort(map { $cpu_list{$_}->{$prop_name} || 0 } @_));
}

#
# Return subset of CPUs sharing specified value of a given cpu_info kstat field.
# Arguments:
#   Property name
#   Property value
#   List of CPUs to select from
#
# Treat undefined values as zeroes.
sub cpus_by_prop
{
	my $prop_name = shift;
	my $prop_val = shift;

return (grep { ($cpu_list{$_}->{$prop_name} || 0) == $prop_val } @_);
}

#
# Build component tree
#
# Arguments:
#    Reference to the list of CPUs sharing the component
#    Reference to the list of sub-components
#
sub build_component_tree
{
	my ($cpus, $comp_list) = @_;
	# Get the first component and the rest
	my ($comp_name, @comps) = @$comp_list;
	my $tree = {};
	if (!$comp_name) {
		$tree->{cpus} = $cpus;
		return ($tree);
	}

# Get all possible component values
	foreach my $v (property_list($comp_name, @$cpus)) {
		my @comp_cpus = cpus_by_prop ($comp_name, $v, @$cpus);
		$tree->{name} = $comp_name;
		$tree->{cpus} = $cpus;
		$tree->{values}->{$v} = build_component_tree(\@comp_cpus,
							     \@comps);
	}
	return ($tree);
}

#
# Print the component tree
# Arguments:
#   Reference to a tree
#   indentation
# Output: maximum indentation
#
sub print_component_tree
{
	my ($tree, $ind) = @_;
	my $spaces = ' ' x $ind; # indentation string
	my $vals = $tree->{values};
	my $retval = $ind;
	if ($vals) {
		# This is not a leaf node
		# Get node name and translate it to printable format
		my $id_name = id_translate($tree->{name});
		# Examine each sub-node
		foreach my $comp_val (nsort(keys %$vals)) {
			my $child_tree = $vals->{$comp_val}; # Sub-tree
			my $child_id = $child_tree->{name}; # Name of child node
			my @cpus = @{$child_tree->{cpus}}; # CPUs for the child
			my $ncpus = scalar @cpus; # Number of CPUs
			my $cpuname = pluralize('processor', $ncpus);
			my $cl = collapse(@cpus); # Printable CPU list
			if (!$child_id) {
				# Child is a leaf node
				print $spaces;
				printf gettext("%s has %d virtual %s"),
				       $id_name, $ncpus, $cpuname;
				print " ($cl)\n";
				$retval = max($retval, $ind + 2);
			} else {
				# Child has several values. Let's see how many
				my $grandchild_tree = $child_tree->{values};
				my $nvals = scalar(keys %$grandchild_tree);
				my $child_id_name = pluralize($child_id,
							      $nvals);
				print $spaces;
				printf
				  gettext("%s has %d %s and %d virtual %s"),
				    $id_name, $nvals, $child_id_name, $ncpus,
				      $cpuname;
				print " ($cl)\n";
				# Print the tree for the child
				$retval = max($retval,
					      print_component_tree($child_tree,
								   $ind + 2));
			}
		}
	}
	return ($retval);
}

#
# Convert a idlist string to an array of integers
#
# Lists with ranges and oommas are accepted, such as 1,3,5-10, which maps
# to 1 3 5 6 7 8 9 10
#
sub idlist2array {
	sort { $a <=> $b } keys %{{ map {
		if (/^\d+$/) {
			$_ => 1;
		} elsif (/^(\d+)\s*-\s*(\d+)$/) {
			map { $_ => 1 } $1 .. $2;
		} else {
			return;
		}
	} split(/\s*,\s*/, $_[0])}}
}

#
# Convert lgrp to latency
#
sub lgrp2latency
{
	my $ltree = shift;
	my $l = shift;

my $latency = $ltree->latency($l, $l);
	my $parent = $l;

# If no latency defined, use latency of parent.
        # 
	while (!defined($latency)) {
		($parent) = $ltree->parents($parent);
		last if (!defined($parent));
		$latency = $ltree->latency($parent, $parent);
	}

if (!defined($latency)) {
		printf STDERR
		gettext("%s: can not get latency information for lgroup: %s\n"),
		    $cmdname, $l;
		exit(1);
	}
	return $latency;
}

#
# Convert and array of ids to a string
#
sub format_idlist
{
	my $parse_view = shift;
	my $str;

if ($parse_view) {
		$str = "@_";
	} else {
		$str = collapse(@_);
	}

return $str;
}

#
# Converts an array of lgrps into a list of lgrps grouped by latency
#
sub format_lgrps
{
	my %latencymap;
	my @latencies;
	my $string = "";
	my $ltree = shift;
	my $parse_view = shift;
	my $printfirst = 0;

foreach my $lgrp (@_) {
		my $latency = lgrp2latency($ltree, $lgrp);
		push (@{$latencymap{$latency}}, scalar($lgrp));
	}
	@latencies = nsort(keys(%latencymap));
	foreach my $latency (@latencies) {

$string = $string . "," if $printfirst;
		$string = $string . " " if $printfirst && ! $parse_view;

if ($parse_view) {
			$string = $string . "@{$latencymap{$latency}}";
		} else {
			$string = $string . collapse(@{$latencymap{$latency}});
		}
		$printfirst = 1;
	}

return $string;
}
############################
# Main part of the program
############################

#
# Option processing
#
my ($opt_t, $opt_L, $opt_v, $opt_p, $opt_P, $opt_silent);

GetOptions("t" => \$opt_t,
	   "L" => \$opt_L,
	   "p" => \$opt_p,
	   "P" => \$opt_P,
 	   "v" => \$opt_v,
 	   "s" => \$opt_silent) || usage();

my $verbosity = 1;
my $phys_view;
my $tree_view;
my $lgrp_view;
my $parse_view;

$verbosity |= 2 if $opt_v;
$verbosity &= ~1 if $opt_silent;
$phys_view = 1 if $opt_p;
$tree_view = 1 if $opt_t;
$lgrp_view = 1 if $opt_L;
$parse_view = 1 if $opt_P;

# Set $phys_verbose if -vp is specified
my $phys_verbose = $phys_view && ($verbosity > 1);

# Verify options
usage(gettext("option -L requires option -t")) if $lgrp_view && !$tree_view;

usage(gettext("option -P requires option -t")) if $parse_view && !$tree_view;

usage(gettext("options -s and -v are mutually exclusive")) if $verbosity == 2;

usage(gettext("options -t and -s are mutually exclusive")) if
    $tree_view && $verbosity == 0;

usage(gettext("options -t and -v are mutually exclusive")) if
    $tree_view && $verbosity == 3;

usage(gettext("options -t and -p are mutually exclusive")) if
    $tree_view && $phys_view;

usage(gettext("must specify exactly one processor if -s used")) if
  (($verbosity == 0) && scalar @ARGV != 1);

#
# Read cpu_info kstats
#
my $ks = Sun::Solaris::Kstat->new(strip_strings => 1) or
  (printf STDERR gettext("%s: kstat_open() failed: %s\n"),
   $cmdname, $!),
    exit(2);
my $cpu_info = $ks->{cpu_info} or
  (printf STDERR gettext("%s: can not read cpu_info kstats\n"),
   $cmdname),
    exit(2);

my (
    @all_cpus,	# List of all CPUs in the system
    @all_cores, # List of all the cores in the system
    @all_chips, # List of all chips in the system
    @all_lgrps, # List of all lgrps in the system
    @cpu_args,	# CPUs to look at
    @core_args,	# Cores to look at
    @chip_args, # Sockets to look at
    @lgrp_args, # lgrps to look at
    @cpus,	# List of CPUs to process
    @id_list,	# list of various xxx_id kstats representing CPU topology
    %chips,	# Hash with chip ID as a key and reference to the list of
		# virtual CPU IDs, belonging to the chip as a value
    %cores,	# Hash with core ID as a key and reference to the list of
		# virtual CPU IDs, belonging to the chip as a value
    %lgrps,	# Hash with lgroup ID as a key and reference to the list of
		# virtual CPU IDs, belonging to the lgrp as a value
    @chip_list,	# List of all chip_id values
    %cpu2chip,  # maps each cpu to a chip
    %core2chip, # maps each core to a chip
    %cpu2core,  # maps each cpu to a core
    %chip2cores,# maps each chip to a list of cores
    %chip2lgrps,# maps each chip to a list of lgrps
    %core2lgrps,# maps each core to a list of lgrps
    %lgrp2cores,# maps each lgrp to a list of cores
    $ctree,	# The component tree
    $ltree	# The lgrp tree
   );

#
#
# get information about each lgrp
#
my $l;

$ltree = Sun::Solaris::Lgrp->new(LGRP_VIEW_OS);
if (!defined($ltree)) {
	printf STDERR gettext(
	    "%s: can not get lgroup information from the system\n"),
	    $cmdname;
	exit(1);
}

#
# Store the list of cpus in each lgrp in the lgrp hash
#
	
foreach $l ($ltree->lgrps) {

my @cpus = uniqsort($ltree->cpus($l, LGRP_CONTENT_HIERARCHY));

@{$lgrps{$l}} = @cpus;
	push (@all_lgrps, scalar($l));
}

@all_lgrps = nsort(@all_lgrps);

#
# Get information about each CPU.
#
#   Collect list of all CPUs in @cpu_list array
#
#   Construct %cpu_list hash keyed by CPU ID with cpu_info kstat hash as its
#   value.
#
#   Construct %chips hash keyed by chip ID. It has a 'cpus' entry, which is
#   a reference to a list of CPU IDs within a chip.
#
foreach my $id (nsort(keys %$cpu_info)) {

# $id is CPU id
	my $info = $cpu_info->{$id};

#
	# The name part of the cpu_info kstat should always be a string
	# cpu_info$id.
	#
	# The $ci hash reference holds all data for a specific CPU id.
	#
	my $ci = $info->{"cpu_info$id"} or next;

# Save CPU-specific information in cpu_list hash, indexed by CPU ID.
	$cpu_list{$id} = $ci;
	my $chip_id = $ci->{'chip_id'};
	my $core_id = $ci->{'core_id'};

$cpu2chip{$id} = $chip_id if (defined($chip_id));
	$cpu2core{$id} = $core_id if (defined($core_id));
 
	# if first time seeing this core, record its chip relationship
	if (defined($chip_id) && defined($core_id) && !$cores{$core_id}) {
		push (@{$chip2cores{$chip_id}}, $core_id);
		$core2chip{$core_id} = $chip_id;
	}

# Collect CPUs within the chip.
	# $chips{$chip_id} is a reference to a list of CPU IDs belonging to thie
	# chip. It is automatically created when first referenced.
	push (@{$chips{$chip_id}}, $id) if (defined($chip_id));
	push (@{$cores{$core_id}}, $id) if (defined($core_id));

# Collect list of CPU IDs in @cpus
	push (@all_cpus, $id);
	
}

# Ensure that cores listed for each chip are in numeric order.
foreach my $id (keys(%chip2cores))  {
	@{$chip2cores{$id}} = uniqsort(@{$chip2cores{$id}});
}

# Create id lists of all chip and cores.
push(@all_chips, nsort(keys(%chips)));
push(@all_cores, nsort(keys(%cores)));

#
# Figure out what CPUs to examine.
# Look at specific CPUs if any are specified on the command line or at all CPUs
# CPU ranges specified in the command line are expanded into lists of CPUs
#
if (scalar(@ARGV) == 0) {
	if ($tree_view) {
		@chip_args = @all_chips;
	} else {
		@cpu_args = @all_cpus;
	}

} elsif ($tree_view) {

#
	# In tree view args are in one of the forms:
	#    socket=id-list
	#    core=id-list
	#    lgrp=id-list
	#
	# Both singular and pluralized forms of the above words are accepted.
	#
	foreach my $arg (@ARGV) {

(my $s) = $arg =~ m/sockets?\s*=\s*(.*)/i;

if (defined($s))  {
			my @a = idlist2array $s;
			if (!@a) {
				usage(gettext("invalid idlist in argument:"),
				    "\"$arg\"");
			}
			push(@chip_args, @a);
		}

my @bad_chips = set_subtract(\@all_chips, \@chip_args);
		my $nbadchips = scalar @bad_chips ;

if ($nbadchips != 0) {
			my $argstr = format_idlist($parse_view, @bad_chips);
			if ($nbadchips > 1) {
				printf STDERR
				    gettext("%s: invalid sockets: %s\n"),
			  	    $cmdname, $argstr;
			} else {
				printf STDERR
				    gettext("%s: invalid socket: %s\n"),
			  	    $cmdname, $argstr;
			}
			$errors = 2;
			@chip_args =
			    uniqsort(intersect(\@all_chips, \@chip_args));

}

(my $c) = $arg =~ m/cores?\s*=\s*(.*)/i;
		if (defined($c))  {
			my @a = idlist2array $c;
			if (!@a) {
				usage(gettext("invalid idlist in argument:"),
				    "\"$arg\"");
			}
			push(@core_args, @a);
		}
		my @bad_cores = set_subtract(\@all_cores, \@core_args);
		my $nbadcores = scalar @bad_cores ;

if ($nbadcores != 0) {
			my $argstr = format_idlist($parse_view, @bad_cores);
			if ($nbadcores > 1) {
				printf STDERR
				    gettext("%s: Invalid cores: %s\n"),
			  	    $cmdname, $argstr;
			} else {
				printf STDERR
				    gettext("%s: Invalid cores: %s\n"),
			  	    $cmdname, $argstr;
			}
			$errors = 2;
			@core_args =
			    uniqsort(intersect(\@all_cores, \@core_args));
		}

(my $p) = $arg =~ m/cpus?\s*=\s*(.*)/i;
		if (defined($p))  {
			my @a = idlist2array $p;
			if (!@a) {
				usage(gettext("invalid idlist in argument:"),
				    "\"$arg\"");
			}
			push(@cpu_args, @a);
		}
		my @bad_cpus = set_subtract(\@all_cpus, \@cpu_args);
		my $nbadcpus = scalar @bad_cpus ;

if ($nbadcpus != 0) {
			my $argstr = format_idlist($parse_view, @bad_cpus);
			if ($nbadcpus > 1) {
				printf STDERR
				    gettext("%s: invalid cpus: %s\n"),
			  	    $cmdname, $argstr;
			} else {
				printf STDERR
				    gettext("%s: invalid cpu: %s\n"),
			  	    $cmdname, $argstr;
			}
			$errors = 2;
			@cpu_args =
			    uniqsort(intersect(\@all_cpus, \@cpu_args));
		}

(my $l) = $arg =~ m/lgroups?=(.*)/;
		if (defined($l))  {
			my @a = idlist2array $l;
			if (!@a) {
				usage(gettext("invalid idlist in argument:"),
				    "\"$arg\"");
			}

#
			# Don't report on lgroups that do not contain any
			# cpus.
			#
			foreach my $a (@a) {
				# Check if lgrp exists but has no cpus
				if ($lgrps{$a} && !@{$lgrps{$a}}) {
		 			printf STDERR
				    	gettext(
					    "%s: lgroup %s contains no cpus\n"),
			  		    $cmdname, $a;

$errors = 2;
					next;
				}
				push(@lgrp_args, $a);
			}
		}
		my @bad_lgrps = set_subtract(\@all_lgrps, \@lgrp_args);
		my $nbadlgrps = scalar @bad_lgrps ;

if ($nbadlgrps != 0) {
			my $argstr = format_idlist($parse_view, @bad_lgrps);
			if ($nbadlgrps > 1) {
		 		printf STDERR
				    gettext("%s: invalid lgroups: %s\n"),
			  	    $cmdname, $argstr;
			} else {
				printf STDERR
				    gettext("%s: invalid lgroup: %s\n"),
			  	    $cmdname, $argstr;
			}
			$errors = 2;
			@lgrp_args =
			    uniqsort(intersect(\@all_lgrps, \@lgrp_args));
		}

if (!defined($s) &&
		    !defined($c) &&
		    !defined($p) &&
		    !defined($l)) {

usage(gettext("invalid argument:"),
			    "\"$arg\"");
		}
	}

# Eliminate redundant args
	@chip_args = uniqsort(@chip_args);
	@core_args = uniqsort(@core_args);
	@cpu_args = uniqsort(@cpu_args);
	@lgrp_args = uniqsort(@lgrp_args);

} else {
	# Expand all x-y intervals in the argument list
	@cpu_args = map { expand($_) } @ARGV;

usage(gettext("must specify exactly one processor if -s used")) if
	    (($verbosity == 0) && scalar @cpu_args != 1);

# Detect invalid CPUs in the arguments
	my @bad_args = set_subtract(\@all_cpus, \@cpu_args);
	my $nbadargs = scalar @bad_args;

if ($nbadargs != 0) {
		# Warn user about bad CPUs in the command line
		my $argstr = collapse(@bad_args);

if ($nbadargs > 1) {
			printf STDERR gettext("%s: Invalid processors %s\n"),
			  $cmdname, $argstr;
		} else {
			printf STDERR
			  gettext("%s: processor %s: Invalid argument\n"),
			  $cmdname, $argstr;
		}
		$errors = 2;
	}

@cpu_args = uniqsort(intersect(\@all_cpus, \@cpu_args));
}

#
# Map all chip and cores to their associated lgrps.
#
# A chip or core is a member of an lgroup if all of its cpus are
# contained within the lgrp.  @all_lgrps is sorted, so the resulting
# per chip and per core lists will also be sorted.
#
if ($lgrp_view || @lgrp_args) {
	foreach my $chip (@all_chips) {
		foreach my $lgrp (@all_lgrps) {
			if (subset(\@{$lgrps{$lgrp}}, \@{$chips{$chip}})) {
				push(@{$chip2lgrps{$chip}}, $lgrp);
			}
		}				
	}

foreach my $core (@all_cores) {
		foreach my $lgrp (@all_lgrps) {
			if (subset(\@{$lgrps{$lgrp}}, \@{$cores{$core}})) {
				push(@{$core2lgrps{$core}}, $lgrp);
				push(@{$lgrp2cores{$lgrp}}, $core);
			}
		}				
	}
}

#
# In physical view, CPUs specified in the command line are only used to identify
# chips. The actual CPUs are all CPUs belonging to these chips.
#
if ($phys_view) {
	# Get list of chips spanning all CPUs specified
	@chip_list = property_list('chip_id', @cpu_args);
	if (!scalar @chip_list && $errors == 0) {
		printf STDERR
		  gettext("%s: Physical processor view not supported\n"),
		    $cmdname;
		exit(1);
	}

# Get list of all CPUs within these chips
	@cpus = uniqsort(map { @{$chips{$_}} } @chip_list);

} elsif (!$tree_view) {
	@cpus = @cpu_args;
}

if ($phys_verbose) {
	#
	# 1) Look at all possible xxx_id properties and remove those that have
	#    NCPU values or one value. Sort the rest.
	#
	# 2) Drop ids which have the same number of entries as number of CPUs or
	#    number of chips.
	#
	# 3) Build the component tree for the system
	#
	foreach my $id (keys %$cpu_info) {
		my $info = $cpu_info->{$id};
		my $name = "cpu_info$id";
		my $ci = $info->{$name}; # cpu_info kstat for this CPU

# Collect all statistic names matching $valid_id_exp
		push @id_list, grep(/$valid_id_exp/, keys(%$ci));
	}

# Remove duplicates
	@id_list = uniq(@id_list);

my $ncpus = scalar @cpus;
	my %prop_nvals;		# Number of instances of each property
	my $nchips = scalar @chip_list;

#
	# Get list of properties which have more than ncpus and less than nchips
	# instances.
	# Also collect number of instances for each property.
	#
	@id_list = grep {
		my @ids = property_list($_, @cpus);
		my $nids = scalar @ids;
		$prop_nvals{$_} = $nids;
		($_ eq "chip_id") ||
		  (($nids > $nchips) && ($nids > 1) && ($nids < $ncpus));
	} @id_list;

# Sort @id_list by number of instances for each property
	@id_list = sort { $prop_nvals{$a} <=> $prop_nvals{$b} } @id_list;

$ctree = build_component_tree(\@cpus, \@id_list);
}

#
# Walk all CPUs specified and print information about them.
# Do nothing for physical view - will do everything later.
#
foreach my $id (@cpus) {
	last if $phys_view;	# physical view is handled later
	last if $tree_view;
	my $cpu = $cpu_list{$id} or next;
	my $mstring = "";

# Get CPU state and its modification time
	my $status = $cpu->{'state'} || gettext("unknown");
	if ($status ne "unknown") {
		my $mtime = $cpu->{'state_begin'};
		$mstring = strftime(gettext("%m/%d/%Y %T"), localtime($mtime));
	}

# Get localized version of CPU status
	$status = $cpu_states{$status} || $status;

if ($verbosity == 0) {
		# Print 1 if CPU is online, 0 if offline.
		printf "%d\n", $status eq 'on-line';
	} elsif (! ($verbosity & 2)) {
		if ($status eq "unknown") {
			printf gettext("%d\t%-8s\n"),
			    $id, $status;
		} else {
			printf gettext("%d\t%-8s  since %s\n"),
				$id, $status, $mstring;
		}
	} else {
		printf gettext("Status of virtual processor %d as of: "), $id;
		print strftime(gettext("%m/%d/%Y %T"), localtime());
		print "\n";

if ($status eq "unknown") {
			printf gettext("  %s.\n"), $status;
			next;
		}

printf gettext("  %s since %s.\n"), $status, $mstring;
		my $clock_speed =  $cpu->{'clock_MHz'};
		my $cpu_type = $cpu->{'cpu_type'};

# Display clock speed
		if ($clock_speed ) {
			printf
			  gettext("  The %s processor operates at %s MHz,\n"),
			       $cpu_type, $clock_speed;
		} else {
			printf
	      gettext("  the %s processor operates at an unknown frequency,\n"),
			$cpu_type;
		}

# Display FPU type
		my $fpu = $cpu->{'fpu_type'};
		if (! $fpu) {
			print
			  gettext("\tand has no floating point processor.\n");
		} elsif ($fpu =~ m/^[aeiouy]/) {
			printf
			 gettext("\tand has an %s floating point processor.\n"),
			   $fpu;
		} else {
			printf
			  gettext("\tand has a %s floating point processor.\n"),
			    $fpu;
		}
	}
}

#
# Physical view print
#
if ($phys_view) {
	if ($verbosity == 1) {
		print scalar @chip_list, "\n";
	} elsif ($verbosity == 0) {
		# Print 1 if all CPUs are online, 0 otherwise.
		foreach my $chip_id (@chip_list) {
			# Get CPUs on a chip
			my @chip_cpus = uniqsort(@{$chips{$chip_id}});
			# List of all on-line CPUs on a chip
			my @online_cpus = grep { 
				($cpu_list{$_}->{state}) eq 'on-line'
			} @chip_cpus;

#
			# Print 1 if number of online CPUs equals number of all
			# CPUs
			#
			printf
			  "%d\n", scalar @online_cpus == scalar @chip_cpus;
		}
	} else {
		# Walk the property tree and print everything in it.
		my $tcores = $ctree->{values};
		my $cname = id_translate($ctree->{name});
		foreach my $chip (nsort(keys %$tcores)) {
			my $chipref = $tcores->{$chip};
			my @chip_cpus = @{$chipref->{cpus}};
			my $ncpus = scalar @chip_cpus;
			my $cpu_id = $chip_cpus[0];
			my $cpu = $cpu_list{$cpu_id};
			my $brand = $cpu->{brand} ||  gettext("(unknown)");
			my $impl = $cpu->{implementation} ||
			  gettext("(unknown)");
			my $socket = $cpu->{socket_type};
			#
			# Remove cpuid and chipid information from
			# implementation string and print it.
			#
			$impl =~ s/(cpuid|chipid)\s*\w+\s+//;
			$brand = '' if $impl && $impl =~ /^$brand/;
			# List of CPUs on a chip
			my $cpu_name = pluralize('processor', $ncpus);
			# Collapse range of CPUs into a-b string
			my $cl = collapse(@chip_cpus);
			my $childname = $chipref->{name};
			if (! $childname) {
				printf gettext("%s has %d virtual %s "),
				       $cname, $ncpus, $cpu_name;
				print "($cl)\n";
				print "  $impl\n" if $impl;
				print "\t$brand" if $brand;
				print "\t[ Socket: $socket ]" if $socket &&
				  $socket ne "Unknown";
				print "\n";
			} else {
				# Get child count
				my $nchildren =
				  scalar(keys(%{$chipref->{values}}));
				$childname = pluralize($childname, $nchildren);
				printf
				  gettext("%s has %d %s and %d virtual %s "),
				       $cname, $nchildren, $childname, $ncpus,
				       $cpu_name;
				print "($cl)\n";
				my $ident = print_component_tree ($chipref, 2);
				my $spaces = ' ' x $ident;
				print "$spaces$impl\n" if $impl;
				print "$spaces  $brand\n" if $brand;
			}
		}
	}
}

if ($tree_view) {

#
	# Print all user requested chips.  If no args, then this will
	# be the list of all chips.
	#
	foreach my $chip (@chip_args) {

my $chiplgrps;
		$chiplgrps = format_lgrps($ltree, $parse_view,
		    @{$chip2lgrps{$chip}}) if $lgrp_view;

if (!$parse_view) {
			printf("socket: $chip");
			if ($lgrp_view) {
				if (scalar(@{$chip2lgrps{$chip}}) > 1) {
					printf(" (lgroups: ");
				} else {
					printf(" (lgroup: ");
				}
				printf("$chiplgrps)");
			}
			printf("\n");
		}
		foreach my $core (@{$chip2cores{$chip}}) {

my $corelgrps;
			$corelgrps = format_lgrps($ltree, $parse_view,
			    @{$core2lgrps{$core}}) if $lgrp_view;

my $cpustring = format_idlist($parse_view,
			    @{$cores{$core}});

if ($parse_view) {
				printf("$corelgrps:") if $lgrp_view;
				printf("$chip:$core:$cpustring\n");
			} else {
				printf("  core: $core");

#
				# printing core level groups is redundant if
				# they are the same as the chip level lgrps.
				#
				if ($lgrp_view && $chiplgrps ne $corelgrps) {
					if (scalar(@{$core2lgrps{$chip}}) > 1)
					{
						printf(" (lgroups: ");
					} else {
						printf(" (lgroup: ");
					}
					printf("$corelgrps)");
				}
				printf("\n");
				if (scalar(@{$cores{$core}}) > 1) {
					printf("    cpus: $cpustring\n");  
				} else {
					printf("    cpu: $cpustring\n");  
				}
			}
		}
	}

#
	# Print all user requested cores.
	#
	# Cores on the same chip are printed sequentially, regardless
	# of the order specified by the user.
	#
	# User requested lgrps are implemented by listing the associated
	# cores.
	#
	my @lgrp_cores;
	foreach my $lgrp (@lgrp_args) {
		push (@lgrp_cores, @{$lgrp2cores{$lgrp}});
	}
	my @cores = uniqsort(@lgrp_cores, @core_args);

my %cores2print = map { $_ => 1 } @cores;
	my %coresprinted;

foreach my $core (@cores) {

next if ($coresprinted{$core});

my $chip = $core2chip{$core};
		my $chiplgrps = format_lgrps($ltree, $parse_view,
		    @{$chip2lgrps{$chip}}) if $lgrp_view;
	
		if (!$parse_view) {
			printf("socket: $chip");
			if ($lgrp_view) {
				if (scalar(@{$chip2lgrps{$chip}}) > 1) {
					printf(" (lgroups: ");
				} else {
					printf(" (lgroup: ");
				}
				printf("$chiplgrps)");
			}
			printf("\n");
		}

foreach my $core (@{$chip2cores{$chip}}) {

next if (!$cores2print{$core});

my $corelgrps;
			$corelgrps = format_lgrps(
			    $ltree, $parse_view,
			    @{$core2lgrps{$core}})
			    if $lgrp_view;
	
			my $cpustring = format_idlist( $parse_view,
			    @{$cores{$core}});

if ($parse_view) {
				printf("$corelgrps:") if $lgrp_view;
				printf("$chip:$core:$cpustring\n");
			} else {
				printf("  core: $core");

#
	# Print all user requested cpus.
	#
	# Cpus on the same core are printed together, regardless of
	# order specified by the user.
	#
	my %cpus2print = map { $_ => 1 } @cpu_args;
	my %cpusprinted;
	undef %coresprinted;

foreach my $cpu (@cpu_args) {

next if ($cpusprinted{$cpu});

my $core = $cpu2core{$cpu};
		my $chip = $core2chip{$core};
		my $chiplgrps = format_lgrps($ltree, $parse_view,
		    @{$chip2lgrps{$chip}}) if $lgrp_view;

foreach my $core (@{$chip2cores{$chip}}) {

next if ($coresprinted{$core});

# print all requested cpus that live on this core
			my @cpus = intersect(\@cpu_args, \@{$cores{$core}});

next if (!@cpus);

my $corelgrps;
			$corelgrps = format_lgrps($ltree, $parse_view,
			    @{$core2lgrps{$core}})
			    if $lgrp_view;

my $cpustring = format_idlist($parse_view,
			    @{$cores{$core}});

if ($parse_view) {
				printf("$corelgrps:") if $lgrp_view;
				printf("$chip:$core:$cpustring\n");
			} else {
				printf("  core: $core");
				#
				# printing core level groups is redundant if
				# they are the same as the chip level lgrps.
				#
				if ($lgrp_view && $chiplgrps ne $corelgrps) {
					if (scalar(@{$core2lgrps{$chip}}) > 1)
					{
						printf(" (lgrps: ");
					} else {
						printf(" (lgrp: ");
					}
					printf("$corelgrps)");
				}
				printf("\n");

if (scalar(@cpus) > 1) {
					printf("    cpus: $cpustring\n");  
				} else {
					printf("    cpu: $cpustring\n");
				}
			}

$coresprinted{$core} = 1;
			foreach my $c (@cpus) {
				$cpusprinted{$c} = 1;
			}
		}
	}
}

exit($errors);

__END__

# The psrinfo command displays information about virtual and physical processors
# in a system. It gets all the information from the 'cpu_info' kstat.
#
# See detailed comment in the end of this file.
#
#
#
# This kstat
# has the following components:
#
# module:	cpu_info
# instance:	CPU ID
# name:		cpu_infoID where ID is CPU ID
# class:	misc
#
# The psrinfo command translates this information from kstat-specific
# representation to user-friendly format.
#
# The psrinfo command has several basic modes of operations:
#
# 1) Without options, it displays a line per CPU with CPU ID and its status and
#    the time the status was last set in the following format:
#
#	0       on-line  since MM/DD/YYYY HH:MM:SS
#	1	on-line  since MM/DD/YYYY HH:MM:SS
#	...
#
#    In this mode, the psrinfo command walks the list of CPUs (either from a
#    command line or all CPUs) and prints the 'state' and 'state_begin' fields
#    of cpu_info kstat structure for each CPU. The 'state_begin' is converted to
#    local time.
#
# 2) With -s option and a single CPU ID as an argument, it displays 1 if the CPU
#    is online and 0 otherwise.
#
# 3) With -p option, it displays the number of physical processors in a system.
#    If any CPUs are specified in the command line, it displays the number of
#    physical processors containing all virtual CPUs specified. The physical
#    processor is identified by the 'chip_id' field of the cpu_info kstat.
#
#    The code just walks over all CPUs specified and checks how many different
#    core_id values they span.
#
# 4) With -v option, it displays several lines of information per virtual CPU,
#    including its status, type, operating speed and FPU type. For example:
#
#	Status of virtual processor 0 as of: MM/DD/YYYY HH:MM:SS
#	  on-line since MM/DD/YYYY HH:MM:SS.
#	  The i386 processor operates at XXXX MHz,
#	        and has an i387 compatible floating point processor.
#	Status of virtual processor 1 as of: MM/DD/YYYY HH:MM:SS
#	  on-line since MM/DD/YYYY HH:MM:SS.
#	  The i386 processor operates at XXXX MHz,
#	        and has an i387 compatible floating point processor.
#
# This works in the same way as 1), just more kstat fields are massaged in the
# output.
#
# 5) With -vp option, it reports additional information about each physical
#    processor. This information includes information about sub-components of
#    each physical processor and virtual CPUs in each sub-component. For
#    example:
#
#	The physical processor has 2 cores and 4 virtual processors (0-3)
#	  The core has 2 virtual processors (0 1)
#	  The core has 2 virtual processors (2 3)
#	    x86 (GenuineIntel family 15 model 4 step 4 clock 3211 MHz)
#	      Intel(r) Pentium(r) D CPU 3.20GHz
#
#    The implementation does not know anything about physical CPU components
#    such as cores. Instead it looks at various cpu_info kstat statistics that
#    look like xxx_id and tries to reconstruct the CPU hierarchy based on these
#    fields. This works as follows:
#
#    a) All kstats statistic names matching the $valid_id_exp regular expression
#       are examined and each kstat statistic name is associated with the number
#       of distinct entries in it.
#
#    b) The resulting list of kstat statistic names is sorted according to the
#       number of distinct entries, matching each name. For example, there are
#       fewer chip_id values than core_id values. This implies that the core is
#	a sub-component of a chip.
#
#    c) All kstat names that have the same number of values as the number of
#       physical processors ('chip_id' values) or the number of virtual
#       processors are removed from the list.
#
#    d) The resulting list represents the CPU hierarchy of the machine. It is
#       translated into a tree showing the hardware hierarchy. Each level of the
#       hierarchy contains the name, reference to a list of CPUs at this level
#       and subcomponents, indexed by the value of each component.
#       The example system above is represented by the following tree:
#
#	$tree =
#	{
#	 'name' => 'chip_id',
#	 'cpus' => [ '0', '1', '2', '3' ]
#	 'values' =>
#	 {
#	  '0' =>
#	  {
#	   'name' => 'core_id',
#	   'cpus' => [ '0', '1', '2', '3' ]
#	   'values' =>
#	   {
#	    '0' => { 'cpus' => [ '0', '1' ] }
#	    '1' => { 'cpus' => [ '2', '3' ] },
#	   },
#	  }
#	 },
#	};
#
#       Each node contains reference to a list of virtual CPUs at this level of
#       hierarchy - one list for a system as a whole, one for chip 0 and one two
#       for each cores. node. Non-leaf nodes also contain the symbolic name of
#       the component as represented in the cpu_info kstat and a hash of
#       subnodes, indexed by the value of the component. The tree is built by
#       the build_component_tree() function.
#
#    e) The resulting tree is pretty-printed showing the number of
#       sub-components and virtual CPUs in each sub-component. The tree is
#       printed by the print_component_tree() function.
#
# 6) With the -t option, a socket/core/cpu tree is printed.
#    If -L is included, the tree is annotated with lgroup membership
#    information.
#
#    If -p is also included, the format is parseable with one line per core in
#    the format:
#
#	socket:core:cpu-list
#
#    or with -L:
#
#	lgrp-list:socket:core:cpu-list
#