#!/usr/bin/perl -W
#
# lscpumf - Display information about CPU-measurement facilities
#
# Copyright IBM Corp. 2014, 2017
#
# s390-tools is free software; you can redistribute it and/or modify
# it under the terms of the MIT license. See LICENSE for details.
#
use strict;
use warnings;
use Data::Dumper;
use File::Basename qw/fileparse/;
use Getopt::Long qw/:config no_ignore_case/;

# Global constants
my $CPUMF_HELPER = '@lib_path@/cpumf_helper';

# Prototypes
sub main();
sub show_help();
sub show_version();
sub do_show_info($);
sub do_show_cf($);
sub do_show_sf($);
sub do_show_ctr($;$);
sub do_show_sf_events($);
sub invoke_cpumf_helper($);


sub main()
{
	my $config = {
		# Internal data
		cpumf	    => {},	# CPU-MF information hash
	};

	unless (GetOptions(
		# General options for help, version,...
		"h|help"	      => \&show_help,
		"v|version"	      => \&show_version,
		# Display options
		"i|info"	      => \$config->{opt_info},
		"c|list-counters"     => \$config->{opt_ctr},
		"C|list-all-counters" => \$config->{opt_ctr_all},
		"s|list-sampling-events" => \$config->{opt_ctr_sf},
	)) {
		print STDERR "One or more options are not valid\n";
		print STDERR "Try '" . fileparse($0) .
			      " --help' for more information\n";
		exit 1;
	}

	# Collect CPU-MF information
	$config->{cpumf} = invoke_cpumf_helper("-i");
	die "Failed to collect CPU-MF information: $!\n" unless $config->{cpumf};

	# Process parameters
	my $exitval = 5;
	if (defined($config->{opt_info})) {
		do_show_cf($config);
		do_show_sf($config);
		$exitval = 0;

	} elsif (defined($config->{opt_ctr})) {
		$exitval = do_show_ctr($config);
	} elsif (defined($config->{opt_ctr_all})) {
		$exitval = do_show_ctr($config, "all")
	} elsif (defined($config->{opt_ctr_sf})) {
		$exitval = do_show_sf_events($config);
	} else {
		$exitval = do_show_info($config);
	}

	exit($exitval);
}

sub show_help()
{
	my $prog = fileparse($0);

	print <<"EoHelp";
Usage:	lscpumf -h|-v
	lscpumf [-i]
	lscpumf -c|-C

Options:
	-i    Displays detailed information.
	-c    Lists counters for which the LPAR is authorized.
	-C    Lists counters regardless of LPAR authorization.
	-s    Lists perf raw events that activate the sampling facility.
	-h    Displays help information, then exits.
	-v    Displays version information, then exits.

For more help information, issue 'man $prog'.
EoHelp
	exit 0;
}

sub show_version()
{
	print <<'EoVersion';
CPU-measurement facility utilities, version @S390_TOOLS_RELEASE@
Copyright IBM Corp. 2014, 2017

EoVersion
	exit 0;
}

sub do_show_info($)
{
	my $c = shift();
	my $cpumf = $c->{cpumf};
	my @f = ();

	push @f, "CPU-measurement Counter Facility" if exists $cpumf->{cf};
	push @f, "CPU-measurement Sampling Facility" if exists $cpumf->{sf};

	if (@f) {
		print((join "\n", @f) . "\n");
	} else {
		print STDERR "No CPU-measurement facilities detected\n";
		return 2;
	}
	return 0;
}

sub do_show_cf($)
{
	my $c = shift();

	# Check if counter facility is available
	unless (exists $c->{cpumf}->{cf}) {
		print STDERR "No CPU-measurement counter facility detected\n";
		return 2;
	}

	# Retrieve counter facility information
	my $cf = $c->{cpumf}->{cf};

	# Create list of authorized counter sets
	my @sets = ();
	push @sets, "None" unless $cf->{auth};
	push @sets, "Crypto-Activity counter set" if $cf->{auth} & 0x8;
	push @sets, "Problem-State counter set" if $cf->{auth} & 0x4;
	push @sets, "Basic counter set" if $cf->{auth} & 0x2;
	push @sets, "Extented counter set" if $cf->{auth} & 0x1;
	push @sets, "MT-diagnostic counter set" if $cf->{auth} & 0x20;

	print "CPU-measurement counter facility\n";
	print "-" x 74 . "\n";
	# TODO Display additional information about available conters depending
	# on the version information
	print "Version: " . $cf->{version} . "\n";
	print "\n";
	print "Authorized counter sets:\n";
	print "    $_\n" foreach (sort @sets);
	printf "\nLinux perf event support: %s\n\n",
	       exists $cf->{perf} ? "Yes (PMU: $cf->{perf})" : "No";

	return 0;
}

sub div_ceil($$)
{
	my ($a, $b) = @_;
	return int(($a + $b - 1) / $b);
}

sub humanize_bytes($;$)
{
	my $bytes = shift();
	my @units = split //, " KMGTPEZY";

	my $u = @_ ? shift() : 0;
	while ($bytes >= 1024 && $u <= $#units) {
		$bytes /= 1024;
		$u++;
	}
	return sprintf "%.f%sB", $bytes, $units[$u];
}

sub get_sfb_details($)
{
	my $n_sdb = shift();

	# Calculate sampling buffer structure
	my $n_sdbt = div_ceil($n_sdb, 511);
	my $n_pages = $n_sdb + $n_sdbt;
	return [
		$n_sdb,		    # number of sample-data-blocks
		$n_sdbt,	    # number of sample-data-block-tables
		$n_pages,	    # number of 4K pages
		$n_pages * 4096,    # size in bytes
	];
}

sub do_show_sf($)
{
	my $c = shift();

	# Check if sampling facility is available
	unless (exists $c->{cpumf}->{sf}) {
		print STDERR "No CPU-measurement sampling facility detected\n";
		return 2;
	}
	my $sf = $c->{cpumf}->{sf};
	my $size = invoke_cpumf_helper("--sfb-size");

	# Sampling facility information
	print "CPU-measurement sampling facility\n";
	print "-" x 74 . "\n";
	print  "Sampling Interval:\n";
	printf "     Minimum: %10u cycles (approx. %8u Hz)\n",
		$sf->{min_sampl_interval},
		1000000 * $sf->{cpu_speed} / $sf->{min_sampl_interval};
	printf "     Maximum: %10u cycles (approx. %8u Hz)\n",
		$sf->{max_sampl_interval},
		1000000 * $sf->{cpu_speed} / $sf->{max_sampl_interval};
	print "\n";
	print "Authorized sampling modes:\n";
	foreach my $m (sort keys %{$sf->{modes}}) {
		printf "     %-10s (sample size: %3u bytes)\n", $m,
		       $sf->{modes}->{$m}->{sample_size};
	}
	print "\n";
	printf "\nLinux perf event support: %s\n\n",
	       exists $sf->{perf} ? "Yes (PMU: $sf->{perf})" : "No";

	# Sampling buffer settings for cpum_sf
	goto out unless exists $sf->{perf};

	print "Current sampling buffer settings for $sf->{perf}:\n";
	printf "    Basic-sampling mode\n";
	my $s = get_sfb_details($size->[0]);
	printf "	Minimum: %6u sample-data-blocks (%6s)\n",
			$s->[0], humanize_bytes($s->[3]);
	$s = get_sfb_details($size->[1]);
	printf "	Maximum: %6u sample-data-blocks (%6s)\n",
			$s->[0], humanize_bytes($s->[3]);
	unless (exists $sf->{modes}->{diagnostic}) {
		goto out;
	}

	# Sampling buffer setting specific to diagnostic-sampling mode
	my $f_diag = div_ceil($sf->{modes}->{diagnostic}->{sample_size},
			      $sf->{modes}->{basic}->{sample_size});
	print  "\n";
	printf "    Diagnostic-sampling mode (including basic-sampling)\n";
	$s = get_sfb_details($size->[0] * $f_diag);
	printf "	Minimum: %6u sample-data-blocks (%6s)\n",
			$s->[0], humanize_bytes($s->[3]);
	$s = get_sfb_details($size->[1] * $f_diag);
	printf "	Maximum: %6u sample-data-blocks (%6s)\n",
			$s->[0], humanize_bytes($s->[3]);
	printf "        Size factor: %2u\n", $f_diag;
out:
	return 0;
}

sub print_counters($$)
{
	my ($ctrdef, $header) = @_;
	my $set_name_map = invoke_cpumf_helper('--ctr-set-names');
	my $out = [];

	my ($ctr_perf, $ctr_num, $set, $name, $desc);
	format PERF_CTR_FORM =
r@<<<<	@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$ctr_perf,   $name

		^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
		$desc
		^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< ~~
		$desc
		@<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
		$set

.
	print $header;
	$~ = "PERF_CTR_FORM";
	foreach my $ctr (sort { $a <=> $b } keys %$ctrdef) {
		$ctr_perf = sprintf "%x", $ctr;
		$ctr_num = $ctr < (1 << 16) ? $ctr : "";
		$name = $ctrdef->{$ctr}->{name};
		$desc = $ctrdef->{$ctr}->{shortdesc} ?
				  $ctrdef->{$ctr}->{shortdesc}
				: $ctrdef->{$ctr}->{desc};
		$desc .= ".";
		$set = $set_name_map->{$ctrdef->{$ctr}->{set}};
		if ($set) {
			$set = "Counter $ctr_num / $set.";
		} else {
			$set = "This event is not associated with a counter set.";
		}
		write;
	}
}

sub do_show_ctr($;$)
{
	my $c = shift();

	# Check if counter facility is available
	unless (exists $c->{cpumf}->{cf}) {
		print STDERR "No CPU-measurement counter facility detected\n";
		return 2;
	}

	# Retrieve counter authorization ("all" or authorized counters only)
	my $auth = @_ ? hex("0xFFFF") : $c->{cpumf}->{cf}->{auth};

	# Retrieve counter information
	my $ctrs = invoke_cpumf_helper("-c $auth");
	unless ($ctrs) {
		print STDERR "No counters are available or authorized\n";
		return 3;
	}

	# Retrieve hardware type
	my $hwtype = invoke_cpumf_helper("--hardware-type");
	my $model = length $hwtype->[1] ? "for $hwtype->[1]" : "";
	my $header = <<"EoHeader";
Perf event counter list $model
==============================================================================

Raw
event	Name	Description
------------------------------------------------------------------------------
EoHeader
	print_counters($ctrs, $header);

	return 0;
}

sub do_show_sf_events($)
{
	my $c = shift();

	# Check if sampling facility is available
	unless (exists $c->{cpumf}->{sf}) {
		print STDERR "No CPU-measurement sampling facility detected\n";
		return 2;
	}
	my $sf = $c->{cpumf}->{sf};
	my $events = invoke_cpumf_helper("--ctr-sf");

	# Remove events with missing authorization
	delete $events->{0xB0000} unless exists $sf->{modes}->{basic};
	delete $events->{0xBD000} unless exists $sf->{modes}->{diagnostic};

	unless ($events) {
		print STDERR "Sampling facility is not authorized\n";
		return 3;
	}

	# Display sampling facility events (aka. counters)
	my $header = <<"EoHeader";
Perf events for activating the sampling facility
==============================================================================

Raw
event	Name	Description
------------------------------------------------------------------------------
EoHeader
	print_counters($events, $header);

	return 0;
}

sub invoke_cpumf_helper($)
{
	my $parms = shift();
	my $result;

	# Call helper module
	my $output = qx"$CPUMF_HELPER $parms";
	die "Failed to run helper module for '$parms'\n" if $? >> 8;
	$result = eval "$output";
	die "Failed to parse helper module data\n" if $@;

	return $result;
}

&main();
__DATA__
__END__