593 lines
15 KiB
Perl
Executable File
593 lines
15 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
########################################################################
|
|
#
|
|
# Copyright (c) 2015-2016 Wind River Systems, Inc.
|
|
#
|
|
# SPDX-License-Identifier: Apache-2.0
|
|
#
|
|
#
|
|
########################################################################
|
|
#
|
|
# Description:
|
|
# This displays per-core occupancy information per sample period.
|
|
# Output includes total occupancy, and per-core occupancy based on
|
|
# hi-resolution timings.
|
|
#
|
|
# Usage: occtop OPTIONS
|
|
# [--delay=<seconds>] [--repeat=<num>] [--period=<seconds>]
|
|
# [--header=<num>]
|
|
# [--help]
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Data::Dumper;
|
|
use POSIX qw(uname strftime);
|
|
use Time::HiRes qw(clock_gettime usleep CLOCK_MONOTONIC CLOCK_REALTIME);
|
|
|
|
use Benchmark ':hireswallclock';
|
|
use Carp qw(croak carp);
|
|
|
|
# Define toolname
|
|
our $TOOLNAME = "occtop";
|
|
our $VERSION = "0.1";
|
|
|
|
# Constants
|
|
use constant SI_k => 1.0E3;
|
|
use constant SI_M => 1.0E6;
|
|
use constant SI_G => 1.0E9;
|
|
use constant Ki => 1024.0;
|
|
use constant Mi => 1024.0*1024.0;
|
|
use constant Gi => 1024.0*1024.0*1024.0;
|
|
|
|
# Globals
|
|
our %percpu_0 = ();
|
|
our %percpu_1 = ();
|
|
our %D_percpu = ();
|
|
our %loadavg = ();
|
|
our $D_total = 0.0;
|
|
our $tm_0 = 0.0;
|
|
our $tm_1 = 0.0;
|
|
our $tr_0 = 0.0;
|
|
our $tr_1 = 0.0;
|
|
our $tm_elapsed = 0.0;
|
|
our $tm_final = 0.0;
|
|
our $uptime = 0.0;
|
|
our $num_cpus = 1;
|
|
our $num_tasks = 0;
|
|
our $num_blk = 0;
|
|
our $print_host = 1;
|
|
our $is_schedstat = 1;
|
|
our $USER_HZ = 100; # no easy way to get this
|
|
our $CLOCK_NS = SI_G / $USER_HZ;
|
|
|
|
# Argument list parameters
|
|
our ($arg_debug,
|
|
$arg_delay,
|
|
$arg_repeat,
|
|
$arg_period,
|
|
$arg_header,
|
|
) = ();
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# MAIN Program
|
|
#-------------------------------------------------------------------------------
|
|
my $MIN_DELAY = 0.001;
|
|
my $MAX_DELAY = 0.001;
|
|
|
|
# benchmark variables
|
|
my ($bd, $b0, $b1);
|
|
|
|
# Autoflush output
|
|
select(STDERR);
|
|
$| = 1;
|
|
select(STDOUT); # default
|
|
$| = 1;
|
|
|
|
# Parse input arguments and print tool usage if necessary
|
|
&parse_occtop_args(
|
|
\$::arg_debug,
|
|
\$::arg_delay,
|
|
\$::arg_repeat,
|
|
\$::arg_period,
|
|
\$::arg_header,
|
|
);
|
|
|
|
# Print out some debugging information
|
|
if (defined $::arg_debug) {
|
|
$Data::Dumper::Indent = 1;
|
|
}
|
|
|
|
# Check for schedstat support; fallback to stats
|
|
$is_schedstat = -e '/proc/schedstat' ? 1 : 0;
|
|
|
|
# Print out selected options
|
|
printf "selected options: delay = %.3fs, repeat = %d, header = %d, source = %s\n",
|
|
$::arg_delay, $::arg_repeat, $::arg_header, $is_schedstat ? 'schedstat' : 'jiffie';
|
|
|
|
# Capture timestamp
|
|
$b0 = new Benchmark;
|
|
|
|
# Get number of logical cpus
|
|
&get_num_logical_cpus(\$::num_cpus);
|
|
|
|
|
|
# Get current hires epoc timestamp
|
|
$::tm_1 = clock_gettime(CLOCK_MONOTONIC);
|
|
$::tr_1 = clock_gettime(CLOCK_REALTIME);
|
|
$::tm_final = $::tm_1 + $::arg_delay*$::arg_repeat;
|
|
|
|
# Set initial delay
|
|
$::tm_elapsed = $::arg_delay;
|
|
$MAX_DELAY = $::arg_delay + $MIN_DELAY;
|
|
|
|
# Get overall per-cpu stats
|
|
if ($is_schedstat) {
|
|
&read_schedstat(\%::percpu_1);
|
|
} else {
|
|
&read_stat(\%::percpu_1);
|
|
}
|
|
|
|
# Main loop
|
|
REPEAT_LOOP: for (my $repeat=1; $repeat <= $::arg_repeat; $repeat++) {
|
|
|
|
# copy all state variables
|
|
%::tm_0 = (); %::tr_0 = (); %::percpu_0 = ();
|
|
$::tm_0 = $::tm_1; $::tr_0 = $::tr_1;
|
|
foreach my $cpu (keys %::percpu_1) { $::percpu_0{$cpu} = $::percpu_1{$cpu}; }
|
|
|
|
# estimate sleep delay to achieve desired interarrival by subtracting out
|
|
# the measured cpu runtime of the tool.
|
|
my $delay = $::arg_delay;
|
|
$delay = $MIN_DELAY if ($delay < $MIN_DELAY);
|
|
$delay = $MAX_DELAY if ($delay > $MAX_DELAY);
|
|
usleep( SI_M*$delay );
|
|
|
|
# Collect current state
|
|
$::tm_1 = (); $::tr_1 = (); %::percpu_1 = ();
|
|
# Get current hires epoc timestamp
|
|
$::tm_1 = clock_gettime(CLOCK_MONOTONIC);
|
|
$::tr_1 = clock_gettime(CLOCK_REALTIME);
|
|
# Get overall per-cpu stats
|
|
if ($is_schedstat) {
|
|
&read_schedstat(\%::percpu_1);
|
|
} else {
|
|
&read_stat(\%::percpu_1);
|
|
}
|
|
|
|
# Get current uptime
|
|
&get_uptime(\$::uptime);
|
|
# Get current loadavg
|
|
&get_loadavg(\%::loadavg, \$::runq, \$::num_tasks);
|
|
# Get current processes blocked
|
|
&get_blocked(\$::num_blk);
|
|
|
|
# Delta calculation
|
|
%::D_percpu = ();
|
|
$::tm_elapsed = $tm_1 - $tm_0;
|
|
foreach my $cpu (keys %::percpu_1) {
|
|
$::D_percpu{$cpu}{'runtime'} = ($::percpu_1{$cpu} - $::percpu_0{$cpu})/1.0E6;
|
|
if ($::tm_elapsed > 0.0) {
|
|
$::D_percpu{$cpu}{'occ'} = 100.0*$D_percpu{$cpu}{'runtime'}/1.0E3/$::tm_elapsed;
|
|
} else {
|
|
$::D_percpu{$cpu}{'occ'} = 0.0;
|
|
}
|
|
}
|
|
|
|
# Print tool header
|
|
if ($repeat == 1) {
|
|
&occtop_header(
|
|
\$::tr_1,
|
|
\$::uptime,
|
|
\%::loadavg,
|
|
\$::runq,
|
|
\$::num_blk,
|
|
\$::num_tasks,
|
|
\$::print_host,
|
|
);
|
|
}
|
|
|
|
# Print one-liner summary
|
|
&print_occtop(
|
|
\$::tr_1,
|
|
\$::num_cpus,
|
|
\%::D_percpu,
|
|
\$::arg_header,
|
|
);
|
|
|
|
# exit repeat loop if we have exceeded overall time
|
|
last if ($::tm_1 > $::tm_final);
|
|
|
|
} # REPEAT LOOP
|
|
|
|
# Print that tool has finished
|
|
print "done\n";
|
|
|
|
# Capture timestamp and report delta
|
|
$b1 = new Benchmark; $bd = Benchmark::timediff($b1, $b0);
|
|
printf "processing time: %s\n", timestr($bd);
|
|
exit 0;
|
|
|
|
|
|
#-------------------------------------------------------------------------------
|
|
|
|
# Parse per-cpu hi-resolution scheduling stats
|
|
sub read_schedstat
|
|
{
|
|
(local *::percpu) = @_;
|
|
my ($version, $timestamp);
|
|
my ($cpu, $cputime);
|
|
my ($fh, $file);
|
|
|
|
%::percpu = ();
|
|
|
|
# parse /proc/schedstat
|
|
$file = '/proc/schedstat';
|
|
open($fh, $file) || croak "Cannot open file: $file ($!)";
|
|
$_ = <$fh>; ($version) = /^version\s+(\d+)/;
|
|
$_ = <$fh>; ($timestamp) = /^timestamp\s+(\d+)/;
|
|
|
|
if ($version == 15) {
|
|
LOOP_SCHEDSTAT: while (<$fh>) {
|
|
# version 15: cputime is 7th field
|
|
if (/^cpu(\d+)\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+\d+\s+(\d+)\s+/) {
|
|
$cpu = $1; $cputime = $2;
|
|
$::percpu{$cpu} = $cputime;
|
|
}
|
|
}
|
|
} else {
|
|
croak "schedstat version: $version method not implemented.";
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
# Parse per-cpu jiffie stats; cputime excludes iowait.
|
|
sub read_stat
|
|
{
|
|
(local *::percpu) = @_;
|
|
my ($cpu, $cputime);
|
|
my ($user, $sys, $nice, $idle, $iowt, $hirq, $sirq);
|
|
my ($fh, $file);
|
|
|
|
%::percpu = ();
|
|
|
|
# parse /proc/stat
|
|
$file = '/proc/stat';
|
|
open($fh, $file) || croak "Cannot open file: $file ($!)";
|
|
LOOP_STAT: while (<$fh>) {
|
|
if (/^cpu(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+(\d+)\s+/) {
|
|
$cpu =$1; $user = $2; $sys = $3; $nice = $4; $idle = $5; $iowt = $6; $hirq = $7; $sirq = $8;
|
|
$cputime = $CLOCK_NS * ($user + $sys + $nice + $iowt + $hirq + $sirq);
|
|
$::percpu{$cpu} = $cputime;
|
|
}
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
# Parse load-average from /proc/loadavg
|
|
sub get_loadavg
|
|
{
|
|
(local *::loadavg, local *::runq, *::num_tasks) = @_;
|
|
|
|
$::loadavg{'1'} = 0.0;
|
|
$::loadavg{'5'} = 0.0;
|
|
$::loadavg{'15'} = 0.0;
|
|
$::runq = 0;
|
|
$::num_tasks = 0;
|
|
|
|
my $file = '/proc/loadavg';
|
|
open(my $fh, $file) || croak "Cannot open file: $file ($!)";
|
|
$_ = <$fh>;
|
|
if (/^(\S+)\s+(\S+)\s+(\S+)\s+(\d+)\/(\d+)\s+\d+/) {
|
|
$::loadavg{'1'} = $1;
|
|
$::loadavg{'5'} = $2;
|
|
$::loadavg{'15'} = $3;
|
|
$::runq = $4;
|
|
$::num_tasks = $5;
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
# Parse blocked from /proc/stat
|
|
sub get_blocked
|
|
{
|
|
(local *::num_blk) = @_;
|
|
|
|
$::num_blk = 0;
|
|
|
|
my $file = '/proc/stat';
|
|
open(my $fh, $file) || croak "Cannot open file: $file ($!)";
|
|
while ($_ = <$fh>) {
|
|
if (/^procs_blocked\s+(\d+)/) {
|
|
$::num_blk = $1;
|
|
}
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
# Parse uptime from /proc/uptime
|
|
sub get_uptime
|
|
{
|
|
(local *::uptime) = @_;
|
|
$::uptime = 0.0;
|
|
|
|
my $file = '/proc/uptime';
|
|
open(my $fh, $file) || croak "Cannot open file: $file ($!)";
|
|
$_ = <$fh>;
|
|
if (/^(\S+)\s+\S+/) {
|
|
$::uptime = $1;
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
# Get number of online logical cpus
|
|
sub get_num_logical_cpus {
|
|
(local *::num_cpus) = @_;
|
|
$::num_cpus = 0;
|
|
|
|
my $file = "/proc/cpuinfo";
|
|
open(my $fh, $file) || croak "Cannot open file: $file ($!)";
|
|
LOOP_CPUINFO: while (<$fh>) {
|
|
if (/^[Pp]rocessor\s+:\s\d+/) {
|
|
$::num_cpus++;
|
|
}
|
|
}
|
|
close($fh);
|
|
}
|
|
|
|
# Print occupancy summary
|
|
sub print_occtop {
|
|
(local *::tr_1,
|
|
local *::num_cpus,
|
|
local *::D_percpu,
|
|
local *::arg_header,
|
|
) = @_;
|
|
|
|
# counter
|
|
our $count;
|
|
$::count++; $::count %= $::arg_header;
|
|
$::count = 1 if ($::arg_header == 1);
|
|
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
|
|
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($::tr_1);
|
|
my $msec = 1000.0*($::tr_1 - int($::tr_1));
|
|
|
|
# Print heading every so often
|
|
if ($::count == 1) {
|
|
printf "%s ".
|
|
"%7s ",
|
|
'yyyy-mm-dd hh:mm:ss.fff',
|
|
'total';
|
|
for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
|
|
printf "%5s ", $cpu;
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
# Print one summary
|
|
my $occ_total = 0.0;
|
|
for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
|
|
$occ_total += $::D_percpu{$cpu}{'occ'};
|
|
}
|
|
printf "%4d-%02d-%02d %02d:%02d:%02d.%03d ".
|
|
"%7.1f ",
|
|
1900+$year, 1+$mon, $mday, $hour, $min, $sec, $msec,
|
|
$occ_total;
|
|
for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
|
|
printf "%5.1f ", $::D_percpu{$cpu}{'occ'};
|
|
}
|
|
print "\n";
|
|
}
|
|
|
|
# Print header
|
|
sub occtop_header {
|
|
(local *::tr_1,
|
|
local *::uptime,
|
|
local *::loadavg,
|
|
local *::runq,
|
|
local *::num_blk,
|
|
local *::num_tasks,
|
|
local *::print_host,
|
|
) = @_;
|
|
|
|
# process epoch to get current timestamp
|
|
my $mm_in_s = 60;
|
|
my $hh_in_s = 60*60;
|
|
my $dd_in_s = 24*60*60;
|
|
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst);
|
|
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($::tr_1);
|
|
my $msec = 1000.0*($::tr_1 - int($::tr_1));
|
|
|
|
# convert uptime to elapsed <d>:<hh>:<mm>:<ss>
|
|
my ($up, $up_dd, $up_hh, $up_mm, $up_ss);
|
|
$up = int($::uptime);
|
|
$up_dd = int($up/$dd_in_s);
|
|
$up -= $dd_in_s*$up_dd;
|
|
$up_hh = int($up/$hh_in_s);
|
|
$up -= $hh_in_s*$up_hh;
|
|
$up_mm = int($up/$mm_in_s);
|
|
$up -= $mm_in_s*$up_mm;
|
|
$up_ss = $up;
|
|
|
|
#occtop -- 2014/03/03 02:00:21.357 ldavg:0.07, 0.09, 0.08 runq:1 nproc:440 up:6:13:00:56
|
|
printf "%s %s -- ".
|
|
"%4d-%02d-%02d %02d:%02d:%02d.%03d ".
|
|
"ldavg:%.2f, %.2f, %.2f runq:%d blk:%d nproc:%d ".
|
|
"up:%d:%02d:%02d:%02d\n",
|
|
$::TOOLNAME, $::VERSION,
|
|
1900+$year, 1+$mon, $mday, $hour, $min, $sec, $msec,
|
|
$::loadavg{'1'}, $::loadavg{'5'}, $::loadavg{'15'},
|
|
$::runq, $::num_blk, $::num_tasks,
|
|
$up_dd, $up_hh, $up_mm, $up_ss;
|
|
|
|
return if (!($::print_host));
|
|
|
|
# After first print, disable print host information
|
|
$::print_host = 0;
|
|
|
|
# Get host specific information
|
|
my ($OSTYPE, $NODENAME, $OSRELEASE, $version, $MACHINE);
|
|
($OSTYPE, $NODENAME, $OSRELEASE, $version, $MACHINE) = POSIX::uname();
|
|
my ($NODETYPE, $SUBFUNCTION, $BUILDINFO) = ('-', '-', '-');
|
|
my ($SW_VERSION, $BUILD_ID) = ('-', '-');
|
|
|
|
# Get platform nodetype and subfunction
|
|
PLATFORM: {
|
|
my $file = "/etc/platform/platform.conf";
|
|
open(FILE, $file) || next;
|
|
while($_ = <FILE>) {
|
|
s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
|
|
if (/^nodetype=(\S+)/) {
|
|
$NODETYPE = $1;
|
|
}
|
|
if (/^subfunction=(\S+)/) {
|
|
$SUBFUNCTION = $1;
|
|
}
|
|
}
|
|
close(FILE);
|
|
}
|
|
|
|
# Get loadbuild info
|
|
BUILD: {
|
|
my $file = "/etc/build.info";
|
|
open(FILE, $file) || next;
|
|
while($_ = <FILE>) {
|
|
s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
|
|
if (/^SW_VERSION=\"([^"]+)\"/) {
|
|
$SW_VERSION = $1;
|
|
}
|
|
if (/^BUILD_ID=\"([^"]+)\"/) {
|
|
$BUILD_ID = $1;
|
|
}
|
|
}
|
|
close(FILE);
|
|
}
|
|
$BUILDINFO = join(' ', $SW_VERSION, $BUILD_ID);
|
|
|
|
# Parse /proc/cpuinfo to get specific processor info
|
|
my ($n_cpu, $model_name, $cpu_MHz) = (0, '-', 0);
|
|
CPUINFO: {
|
|
my $file = "/proc/cpuinfo";
|
|
open(FILE, $file) || croak "Cannot open file: $file ($!)";
|
|
while($_ = <FILE>) {
|
|
s/[\0\e\f\r\a]//g; chomp; # strip control characters if any
|
|
if (/^[Pp]rocessor\s+:\s+\d+/) {
|
|
$n_cpu++;
|
|
} elsif (/^model name\s+:\s+(.*)$/) {
|
|
$_ = $1; s/\s+/ /g;
|
|
$model_name = $_;
|
|
} elsif (/^cpu MHz\s+:\s+(\S+)/) {
|
|
$cpu_MHz = $1;
|
|
} elsif (/^bogomips\s+:\s+(\S+)/) {
|
|
$cpu_MHz = $1 if ($cpu_MHz == 0);
|
|
}
|
|
}
|
|
close(FILE);
|
|
}
|
|
|
|
printf " host:%s nodetype:%s subfunction:%s\n",
|
|
$NODENAME, $NODETYPE, $SUBFUNCTION;
|
|
printf " arch:%s processor:%s speed:%.0f #CPUs:%d\n",
|
|
$MACHINE, $model_name, $cpu_MHz, $n_cpu;
|
|
printf " %s %s build:%s\n", $OSTYPE, $OSRELEASE, $BUILDINFO;
|
|
|
|
}
|
|
|
|
# Parse and validate command line arguments
|
|
sub parse_occtop_args {
|
|
(local *::arg_debug,
|
|
local *::arg_delay,
|
|
local *::arg_repeat,
|
|
local *::arg_period,
|
|
local *::arg_header,
|
|
) = @_;
|
|
|
|
# Local variables
|
|
my ($fail, $arg_help);
|
|
|
|
# Use the Argument processing module
|
|
use Getopt::Long;
|
|
|
|
# Print usage if no arguments
|
|
if (!@::ARGV) {
|
|
&Usage();
|
|
exit 0;
|
|
}
|
|
|
|
# Process input arguments
|
|
$fail = 0;
|
|
GetOptions(
|
|
"debug:i", \$::arg_debug,
|
|
"delay=f", \$::arg_delay,
|
|
"period=i", \$::arg_period,
|
|
"repeat=i", \$::arg_repeat,
|
|
"header:i", \$::arg_header,
|
|
"help|h", \$arg_help
|
|
) || GetOptionsMessage();
|
|
|
|
# Print help documentation if user has selected --help
|
|
&ListHelp() if (defined $arg_help);
|
|
|
|
# Validate options
|
|
if ((defined $::arg_repeat) && (defined $::arg_period)) {
|
|
$fail = 1;
|
|
warn "$::TOOLNAME: Input error: cannot specify both --repeat and --period options.\n";
|
|
}
|
|
if ((defined $::arg_delay) && ($::arg_delay < 0.01)) {
|
|
$fail = 1;
|
|
warn "$::TOOLNAME: Input error: --delay %f is less than 0.01.\n",
|
|
$::arg_delay;
|
|
}
|
|
if (@::ARGV) {
|
|
$fail = 1;
|
|
warn "$::TOOLNAME: Input error: not expecting these options: '@::ARGV'.\n";
|
|
}
|
|
|
|
# Set reasonable defaults
|
|
$::arg_header ||= 15;
|
|
$::arg_delay ||= 1.0;
|
|
$::arg_repeat ||= 1;
|
|
if ($::arg_period) {
|
|
$::arg_repeat = $::arg_period / $::arg_delay;
|
|
} else {
|
|
$::arg_period = $::arg_delay * $::arg_repeat;
|
|
}
|
|
|
|
# Upon missing or invalid options, print usage
|
|
if ($fail == 1) {
|
|
&Usage();
|
|
exit 1;
|
|
}
|
|
}
|
|
|
|
# Print out a warning message and usage
|
|
sub GetOptionsMessage {
|
|
warn "$::TOOLNAME: Error processing input arguments.\n";
|
|
&Usage();
|
|
exit 1;
|
|
}
|
|
|
|
# Print out program usage
|
|
sub Usage {
|
|
printf "Usage: $::TOOLNAME OPTIONS\n";
|
|
printf " [--delay=<seconds>] [--repeat=<num>] [--period=<seconds>]\n";
|
|
printf " [--header=<num>]\n";
|
|
printf " [--help]\n";
|
|
|
|
printf "\n";
|
|
}
|
|
|
|
# Print tool help
|
|
sub ListHelp {
|
|
printf "$::TOOLNAME -- display hi-resolution per-cpu occupancy\n";
|
|
&Usage();
|
|
printf "Options: miscellaneous\n";
|
|
printf " --delay=<seconds> : output interval (seconds): default: 1.0\n";
|
|
printf " --repeat=<num> : number of repeat samples: default: 1\n";
|
|
printf " --period=<seconds> : overall tool duration (seconds): default: --\n";
|
|
printf " --header=<num> : print header every num samples: default: 15\n";
|
|
printf " --help : this help\n";
|
|
exit 0;
|
|
}
|
|
|
|
1;
|