#!/usr/bin/perl
########################################################################
#
# Copyright (c) 2015-2016 Wind River Systems, Inc.
#
# SPDX-License-Identifier: Apache-2.0
#
# 
########################################################################
#
# Description:
#  This displays occupancy and scheduling information per sample period.
#  Output includes total occupancy, per-core occupancy, loadavg, per-task cpu,
#  per-task scheduling, per-task io-wait.
#
# Usage: schedtop OPTIONS
#  [--delay=<seconds>] [--repeat=<num>] [--period=<seconds>]
#  [--reset-hwm] [--idle] [--sort=<cpu|io>]
#  [--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);
use Math::BigInt;

# Define toolname
our $TOOLNAME = "schedtop";
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 %opt_V = ();
our %opt_P = ();
our %percpu_0 = ();
our %percpu_1 = ();
our %task_0 = ();
our %task_1 = ();
our %tids_0 = ();
our %tids_1 = ();
our %D_task  = ();
our %D_percpu = ();
our %loadavg = ();
our $tm_0 = ();
our $tm_1 = ();
our $tr_0 = ();
our $tr_1 = ();
our $tm_elapsed = ();
our $tr_elapsed = ();
our $tm_final = ();
our $uptime = ();
our $num_cpus = 1;
our $affinity_mask = Math::BigInt->new('0');
our $w_aff = 10;
our $num_tasks = 0;
our $num_blk = 0;
our $is_schedstat = 1;
our $USER_HZ = 100; # no easy way to get this
our $CLOCK_NS = SI_G / $USER_HZ;
our $print_host = 1;

# Print options
our ($P_none, $P_lite, $P_brief, $P_full) = (0, 1, 2, 3);
our ($P_ps, $P_cpu, $P_del, $P_io, $P_id, $P_cmd) = (0, 1, 2, 3, 4, 5);
our @P_list = ($::P_ps, $::P_cpu, $::P_del, $::P_io, $::P_id, $::P_cmd);

# Argument list parameters
our ($arg_debug,
     $arg_delay,
     $arg_repeat,
     $arg_period,
     $arg_reset_hwm,
     $arg_idle,
     $arg_sort,
     $arg_print) = ();

#-------------------------------------------------------------------------------
# MAIN Program
#-------------------------------------------------------------------------------
my $ONE_BILLION = 1.0E9;
my $MIN_DELAY = 0.001;
my $MAX_DELAY = 0.001;

# benchmark variables
my ($bd, $b0, $b1);
my @policies = ('OT', 'FF', 'RR', 'BA', 'ID', 'UN', 'UN');
my @delta_list = (
  'nr_switches',
  'nr_migrations',
  'exec_runtime',
  'wait_sum',
  'wait_count',
  'iowait_sum',
  'iowait_count',
  'syscr',
  'syscw',
  'read_bytes',
  'write_bytes',
  'cancelled_write_bytes',
);

my @state_list = (
  'exec_max', 'wait_max',
  'pid', 'ppid', 'state', 'comm', 'cmdline', 'wchan', 'affinity',
  'VmSize', 'VmRSS', 'start_time',
  'nice', 'policy', 'priority', 'rt_priority', 'task_cpu'
);

# Autoflush output
select(STDERR);
$| = 1;
select(STDOUT); # default
$| = 1;

# Parse input arguments and print tool usage if necessary
&parse_schedtop_args(
  \$::arg_debug,
  \$::arg_delay,
  \$::arg_repeat,
  \$::arg_period,
  \$::arg_reset_hwm,
  \$::arg_idle,
  \$::arg_sort,
  \$::arg_print,
);

# Set default print options
if ($::arg_print eq 'full') {
  for my $P (@::P_list) { $::opt_P{$P} = $::P_full; }
} elsif ($::arg_print eq 'brief') {
  for my $P (@::P_list) { $::opt_P{$P} = $::P_brief; }
} else {
  for my $P (@::P_list) { $::opt_P{$P} = $::P_none; }
}
# Disable some options if data not present
$::opt_V{'sched'} = &is_sched();
$::opt_V{'io'} = &is_io();
if ($::opt_V{'sched'} == 0) {
  $::opt_P{$::P_cpu} = $::P_none;
  $::opt_P{$::P_del} = $::P_none;
  $::opt_P{$::P_io}  = $::P_none;
  undef $::arg_reset_hwm;
}
if ($::opt_V{'io'} == 0) {
  if ($::opt_V{'sched'} == 0) {
    $::opt_P{$::P_io} = $::P_none;
    $::arg_sort = 'cpu';
  } else {
    if ($::opt_P{$::P_io} != $::P_none) {
      $::opt_P{$::P_io} = $::P_lite;
    }
  }
}

# Check for root user
if ($>) {
  warn "$::TOOLNAME: requires root/sudo.\n";
  exit 1;
}

# 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, idle=%s, hwm=%s, sort=%s, print=%s\n",
  $::arg_delay, $::arg_repeat,
  (defined $::arg_idle ? 'idle_tasks' : 'no_idle_tasks'),
  (defined $::arg_reset_hwm ? 'reset-hwm' : 'unchanged'),
  $::arg_sort, $::arg_print;

# Capture timestamp
$b0 = new Benchmark;

# Get number of logical cpus
&get_num_logical_cpus(\$::num_cpus);
$::affinity_mask = Math::BigInt->new('0');
for (my $i=0; $i < $::num_cpus; $i++) {
  my $y = Math::BigInt->new('1');
  $y->blsft($i);
  $::affinity_mask->bior($y);
}
$w_aff = &max(length 'AFF', length $::affinity_mask->as_hex());

# Reset scheduling hi-water marks
if (defined $::arg_reset_hwm) {
  &get_tids(\%::tids_1);
  &reset_sched_hwm(\%::tids_1);
  sleep(0.001);
}

# 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);
}
# Get list of pids and tids
&get_tids(\%::tids_1);
# Get current scheduling and io info for all tids
&read_sched(\%::tids_1, \%::task_1);

# determine column sort order
my ($s_key1, $s_key2, $s_key3) = ();
if ($::arg_sort eq 'cpu') {
  ($s_key1, $s_key2, $s_key3) = ('exec_runtime', 'nr_switches', 'pid');
} elsif ($::arg_sort eq 'io') {
  ($s_key1, $s_key2, $s_key3) = ('io', 'ios', 'exec_runtime');
} else {
  ($s_key1, $s_key2, $s_key3) = ('exec_runtime', 'nr_switches', , 'pid');
}

# Main loop
REPEAT_LOOP: for (my $repeat=1; $repeat <= $::arg_repeat; $repeat++) {

  # copy all state variables
  $::tm_0 = (); $::tr_0 = (); %::percpu_0 = (); %::tids_0 = (); %::task_0 = ();
  $::tm_0 = $::tm_1; $::tr_0 = $::tr_1;
  foreach my $cpu (keys %::percpu_1) { $::percpu_0{$cpu} = $::percpu_1{$cpu}; }
  foreach my $tid (keys %::tids_1)   { $::tids_0{$tid} = $::tids_1{$tid}; }
  foreach my $tid (keys %::task_1)   {
    foreach my $var (keys $::task_1{$tid}) {
      $::task_0{$tid}{$var} = $::task_1{$tid}{$var};
    }
  }

  # estimate sleep delay to achieve desired interarrival by subtracting out
  # the measured cpu runtime of the tool.
  my $delay = $::arg_delay;
  if (defined $::D_task{$$}{'exec_runtime'}) {
    $delay -= ($::D_task{$$}{'exec_runtime'}/SI_k);
  }
  $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 = (); %::tids_1 = (); %::task_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 list of pids and tids
  &get_tids(\%::tids_1);
  # Get current scheduling and io info for all tids
  &read_sched(\%::tids_1, \%::task_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_task = (); %::D_percpu = ();
  $::tm_elapsed = $::tm_1 - $::tm_0;
  $::tr_elapsed = $::tr_1 - $::tr_0;
  foreach my $tid (keys %::task_1) {
    next if ( !(exists $::task_0{$tid}) );

    # simple delta
    foreach my $var (@delta_list) {
      $::D_task{$tid}{$var} = ($::task_1{$tid}{$var} - $::task_0{$tid}{$var});
    }
    # state information
    foreach my $state (@state_list) {
      $::D_task{$tid}{$state} = $::task_1{$tid}{$state};
    }

    # derived calculations
    my $exec_runtime = $::D_task{$tid}{'exec_runtime'};
    my $nr_switches  = $::D_task{$tid}{'nr_switches'};
    my $iowait_sum   = $::D_task{$tid}{'iowait_sum'};
    if ($nr_switches > 0.0) {
      $::D_task{$tid}{'tlen'} = $exec_runtime / $nr_switches;
    } else {
      $::D_task{$tid}{'tlen'} = 0.0;
    }
    if ($::tm_elapsed > 0.0) {
      $::D_task{$tid}{'occ'} = 100.0*$exec_runtime/1.0E3/$::tm_elapsed;
      $::D_task{$tid}{'iowait'} = 100.0*$iowait_sum/1.0E3/$::tm_elapsed;
    } else {
      $::D_task{$tid}{'occ'} = 0.0;
      $::D_task{$tid}{'iowait'} = 0.0;
    }
    $::D_task{$tid}{'io'} = $::D_task{$tid}{'read_bytes'}
                          + $::D_task{$tid}{'write_bytes'}
                          + $::D_task{$tid}{'cancelled_write_bytes'};
    $::D_task{$tid}{'ios'} = $::D_task{$tid}{'syscw'}
                           + $::D_task{$tid}{'iowait_count'};
  }

  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;
    }
  }
  my $occ_total = 0.0;
  for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
    $occ_total += $::D_percpu{$cpu}{'occ'};
  }

  # Print summary
  &schedtop_header(
    \$::tr_1,
    \$::tm_elapsed,
    \$::tr_elapsed,
    \$::uptime,
    \$::loadavg,
    \$::runq,
    \$::num_blk,
    \$::num_tasks,
    \$::print_host
  );

  printf "%-5s %7s ", 'core:', 'total';
  for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
    printf "%5s ", $cpu;
  }
  print "\n";
  printf "%-5s %7.1f ", 'occ:', $occ_total;
  for (my $cpu=0; $cpu < $::num_cpus; $cpu++) {
    printf "%5.1f ", $::D_percpu{$cpu}{'occ'};
  }
  print "\n";
  print "\n";

  # Build up output line by specific area
  my $L = ();
  $L = '';
  $L .= sprintf "%6s %6s %6s ", "TID", "PID", "PPID";
  if ($::opt_P{$::P_ps} != $::P_none) {
    $L .= sprintf "%1s %2s %*s %2s %3s %4s ",
            "S", "P", $w_aff, "AFF", "PO", "NI", "PR";
  }
  if ($::opt_P{$::P_cpu} == $::P_brief) {
    $L .= sprintf "%6s %7s ", "ctxt", "occ";
  } elsif ($::opt_P{$::P_cpu} == $::P_full) {
    $L .= sprintf "%6s %6s %7s ", "ctxt", "migr", "occ";
  }
  if ($::opt_P{$::P_del} != $::P_none) {
    $L .= sprintf "%7s %7s %7s %7s ", "tlen", "tmax", "delay", "dmax";
  }
  if ($::opt_P{$::P_io} == $::P_lite) {
    $L .= sprintf "%7s %6s ", "iowt", "iocnt";
  } elsif ($::opt_P{$::P_io} == $::P_brief) {
    $L .= sprintf "%7s %8s %8s ", "iowt", "read", "write";
  } elsif ($::opt_P{$::P_io} == $::P_full) {
    $L .= sprintf "%7s %8s %8s %8s %8s %8s ",
            "iowt", "read", "write", "wcncl", "rsysc", "wsysc";
  }
  if ($::opt_P{$::P_id} != $::P_none) {
    $L .= sprintf "%-22s ", "wchan";
  }
  if ($::opt_P{$::P_cmd} == $::P_brief) {
    $L .= sprintf "%s", "cmdline";
  } elsif ($::opt_P{$::P_cmd} == $::P_full) {
    $L .= sprintf "%-15s %s", "comm", "cmdline";
  }
  print $L, "\n";

  foreach my $tid (sort {($D_task{$b}{$s_key1} <=> $D_task{$a}{$s_key1}) or
                           ($D_task{$b}{$s_key2} <=> $D_task{$a}{$s_key2}) or
                           ($D_task{$b}{$s_key3} <=> $D_task{$a}{$s_key3})} keys %D_task) {
    my $exec_runtime = $::D_task{$tid}{'exec_runtime'};
    my $nr_switches = $::D_task{$tid}{'nr_switches'};
    my $aff = $::D_task{$tid}{'affinity'}->as_hex();

    # skip printing if there is no actual delta
    if ( !(defined $::arg_idle) ) {
      next if (($exec_runtime == 0.0) && ($nr_switches == 0));
    }

    # Build up output line by specific area
    $L = '';
    $L .= sprintf "%6d %6d %6d ",
            $tid, $::D_task{$tid}{'pid'}, $::D_task{$tid}{'ppid'};
    if ($::opt_P{$::P_ps} != $::P_none) {
      $L .= sprintf "%1s %2d %*s %2s %3d %4d ",
              $::D_task{$tid}{'state'}, $::D_task{$tid}{'task_cpu'}, $w_aff, $aff,
              $policies[$::D_task{$tid}{'policy'}], $::D_task{$tid}{'nice'},
              $::D_task{$tid}{'priority'};
    }
    if ($::opt_P{$::P_cpu} == $::P_brief) {
      $L .= sprintf "%6d %7.2f ",
            $::D_task{$tid}{'nr_switches'}, $::D_task{$tid}{'occ'};
    } elsif ($::opt_P{$::P_cpu} == $::P_full) {
      $L .= sprintf "%6d %6d %7.2f ",
              $::D_task{$tid}{'nr_switches'}, $::D_task{$tid}{'nr_migrations'},
              $::D_task{$tid}{'occ'},
    }
    if ($::opt_P{$::P_del} != $::P_none) {
      $L .= sprintf "%7.3f %7.1f %7.3f %7.1f ",
              $::D_task{$tid}{'tlen'}, $::D_task{$tid}{'exec_max'},
              $::D_task{$tid}{'wait_sum'}, $::D_task{$tid}{'wait_max'};
    }
    if ($::opt_P{$::P_io} == $::P_lite) {
      $L .= sprintf "%7.2f %6d ",
              $::D_task{$tid}{'iowait'}, $::D_task{$tid}{'iowait_count'};
    } elsif ($::opt_P{$::P_io} == $::P_brief) {
      $L .= sprintf "%7.2f %8s %8s ",
              $::D_task{$tid}{'iowait'},
              &format_SI($::D_task{$tid}{'read_bytes'}),
              &format_SI($::D_task{$tid}{'write_bytes'});
    } elsif ($::opt_P{$::P_io} == $::P_full) {
      $L .= sprintf "%7.2f %8s %8s %8s %8s %8s ",
              $::D_task{$tid}{'iowait'},
              &format_SI($::D_task{$tid}{'read_bytes'}),
              &format_SI($::D_task{$tid}{'write_bytes'}),
              &format_SI($::D_task{$tid}{'cancelled_write_bytes'}),
              &format_SI($::D_task{$tid}{'syscr'}),
              &format_SI($::D_task{$tid}{'syscw'});
    }
    if ($::opt_P{$::P_id} != $::P_none) {
      $L .= sprintf "%-22s ", substr($::D_task{$tid}{'wchan'}, 0, 22);
    }
    if ($::opt_P{$::P_cmd} == $::P_brief) {
      $L .= sprintf "%s", $::D_task{$tid}{'cmdline'};
    } elsif ($::opt_P{$::P_cmd} == $::P_full) {
      $L .= sprintf "%-15s %s",
              $::D_task{$tid}{'comm'}, $::D_task{$tid}{'cmdline'};
    }
    print $L, "\n";
  }
  print "\n";

  # 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;


#-------------------------------------------------------------------------------
# Convert a number to SI unit xxx.yyyG
sub format_SI
{
  (my $value) = @_;
  if ($value >= SI_G) {
    return sprintf("%.3fG", $value/SI_G);
  } elsif ($value >= SI_M) {
    return sprintf("%.3fM", $value/SI_M);
  } elsif ($value >= SI_k) {
    return sprintf("%.3fk", $value/SI_k);
  } else {
    return sprintf("%.0f", $value);
  }
}

# Convert to IEC binary unit xxx.yyyGi
# Since underlying memory units are in pages, don't need decimals for Ki
sub format_IEC
{
  (my $value) = @_;
  if ($value >= Gi) {
    return sprintf("%.3fGi", $value/Gi);
  } elsif ($value >= Mi) {
    return sprintf("%.3fMi", $value/Mi);
  } elsif ($value >= Ki) {
    return sprintf("%.0fKi", $value/Ki);
  } else {
    return sprintf("%.0f", $value);
  }
}

# Determine whether scheduler stats are available
sub is_sched
{
  return (-e '/proc/1/task/1/sched') ? 1 : 0;
}

# Determine whether IO stats are available
sub is_io
{
  return (-e '/proc/1/task/1/io') ? 1 : 0;
}

# Determine max of array
sub max {
  my ($max, @vars) = @_;
  for (@vars) {
    $max = $_ if $_ > $max;
  }
  return $max;
}

# Determine tids and pid mapping by walking /proc/<pid>/task/<tid>
sub get_tids
{
  (local *::tids) = @_;
  my (@pids_, @tids_) = ();
  my ($dh, $pid, $tid);

  # get pid list
  my $dir = '/proc';
  opendir($dh, $dir) || croak "Cannot open directory: $dir ($!)";
  @pids_ = grep { /^\d+$/ && -d "$dir/$_" } readdir($dh);
  closedir $dh;

  # get tid list
  foreach $pid (@pids_) {
      $dir = '/proc/' . $pid . '/task';
      opendir(my $dh, $dir) || next;
      @tids_ = grep { /^\d+$/ && -d "$dir/$_" } readdir($dh);
      closedir $dh;
      foreach $tid (@tids_) { $::tids{$tid} = $pid; }
  }
}

# Reset scheduling hi-water-marks
sub reset_sched_hwm
{
  (local *::tids) = @_;

  # reset scheduling hi-water-marks by writing '0' to each task
  foreach my $tid (keys %::tids) {
    my $file = '/proc/' . $tid . '/sched';
    open(my $fh, "> $file") || next;
    print $fh "0\n";
    close($fh);
  }
}

# Parse cpu and scheduling info for each tid
# - ignore the specific tid if there is incomplete data,
#   (i.e., cannot obtain info because task has died,
#    eg. missing ./stat, ./status, ./cmdline, ./wchan)
#
sub read_sched
{
  (local *::tids, local *::task) = @_;

  %::task = ();
  foreach my $tid (keys %::tids) {
    my ($fh, $file, $pid, $comm, $cmdline, $wchan, $id) = ();
    my ($tpid, $tcomm, $state, $ppid, $pgrp, $sid,
        $tty_nr, $tty_pgrp, $flags,
        $min_flt, $cmin_flt, $maj_flt, $cmaj_flt,
        $utime, $stime, $cutime, $cstime,
        $priority, $nice, $num_threads,
        $it_real_value, $start_time,
        $vsize, $rss, $rsslim,
        $start_code, $end_code, $start_stack, $esp, $eip,
        $pending, $blocked, $sigign, $sigcatch, $wchan_addr,
        $dum1, $dum2, $exit_signal, $task_cpu,
        $rt_priority, $policy, $blkio_ticks,
        $gtime, $cgtime,
        $start_data, $end_data, $start_brk, $arg_start, $arg_end,
        $env_start, $env_end, $exit_code) = ();

    my ($nr_switches, $nr_migrations) = (0,0);
    my ($exec_runtime, $exec_max) = (0.0, 0.0);
    my ($wait_max, $wait_sum, $wait_count) = (0.0, 0.0, 0);
    my ($iowait_sum, $iowait_count) = (0.0, 0);
    my ($VmSize, $VmRSS) = ();
    my $Cpus_allowed = Math::BigInt->new('0');
    my $affinity = Math::BigInt->new('0');
    my ($rchar, $wchar, $syscr, $syscw, $read_bytes, $write_bytes,
        $cancelled_write_bytes) = (0,0,0,0,0,0,0);

    my ($sched_valid, $io_valid, $status_valid, $cmdline_valid,
        $wchan_valid, $stat_valid) = ();

    $pid = $::tids{$tid};

    # NOTE: Format change over time: OLD: se.statistics.X, NEW: se.statistics->X
    #cat /proc/1/sched
    #systemd (1, #threads: 1)
    #-------------------------------------------------------------------
    #se.exec_start                                :      33792676.285222
    #se.vruntime                                  :      28019997.693224
    #se.sum_exec_runtime                          :         21918.207287
    #se.nr_migrations                             :                 5413
    #se.statistics->sum_sleep_runtime             :       1166561.198533
    #se.statistics->wait_start                    :             0.000000
    #se.statistics->sleep_start                   :      33792676.285222
    #se.statistics->block_start                   :             0.000000
    #se.statistics->sleep_max                     :         18951.679990
    #se.statistics->block_max                     :             0.000000
    #se.statistics->exec_max                      :             0.909747
    #se.statistics->slice_max                     :             1.790123
    #se.statistics->wait_max                      :             4.026544
    #se.statistics->wait_sum                      :           507.245963
    #se.statistics->wait_count                    :                 2540
    #se.statistics->iowait_sum                    :             0.000000
    #se.statistics->iowait_count                  :                    0
    #se.statistics->nr_migrations_cold            :                    0
    #se.statistics->nr_failed_migrations_affine   :                   67
    #se.statistics->nr_failed_migrations_running  :                    1
    #se.statistics->nr_failed_migrations_hot      :                    1
    #se.statistics->nr_forced_migrations          :                    0
    #se.statistics->nr_wakeups                    :                 2472
    #se.statistics->nr_wakeups_sync               :                   34
    #se.statistics->nr_wakeups_migrate            :                  176
    #se.statistics->nr_wakeups_local              :                 1442
    #se.statistics->nr_wakeups_remote             :                 1030
    #se.statistics->nr_wakeups_affine             :                  155
    #se.statistics->nr_wakeups_affine_attempts    :                  969
    #se.statistics->nr_wakeups_passive            :                    0
    #se.statistics->nr_wakeups_idle               :                    0
    #avg_atom                                     :             0.286970
    #avg_per_cpu                                  :             4.049179
    #nr_switches                                  :                76378
    #nr_voluntary_switches                        :                72308
    #nr_involuntary_switches                      :                 4070
    #se.load.weight                               :                 1024
    #policy                                       :                    0
    #prio                                         :                  120
    #clock-delta                                  :                   28

    # parse /proc/<pid>/task/<tid>/sched
    $file = '/proc/' . $pid . '/task/' . $tid . '/sched';
    open($fh, $file) || goto SKIP_SCHED;
    $_ = <$fh>;
    if (/^(.*)\s+\((\d+),\s+#threads:/) {
      $comm = $1; $id = $2;
    }
    my ($k, $v, $c0);
    LOOP_SCHED: while (<$fh>) {
      if (/^se\.statistics.{1,2}wait_max\s+:\s+(\S+)/) {
        $wait_max = $1;
      } elsif (/^se\.statistics.{1,2}wait_sum\s+:\s+(\S+)/) {
        $wait_sum = $1;
      } elsif (/^se\.statistics.{1,2}wait_count\s+:\s+(\S+)/) {
        $wait_count = $1;
      } elsif (/^se\.statistics.{1,2}exec_max\s+:\s+(\S+)/) {
        $exec_max = $1;
      } elsif (/^se\.statistics.{1,2}iowait_sum\s+:\s+(\S+)/) {
        $iowait_sum = $1;
      } elsif (/^se\.statistics.{1,2}iowait_count\s+:\s+(\S+)/) {
        $iowait_count = $1;
      } elsif (/^se\.sum_exec_runtime\s+:\s+(\S+)/) {
        $exec_runtime = $1;
      } elsif (/^se\.nr_migrations\s+:\s+(\S+)/) {
        $nr_migrations = $1;
      } elsif (/^nr_switches\s+:\s+(\S+)/) {
        $nr_switches = $1;
        $sched_valid = 1;
        last LOOP_SCHED;
      }
    }
    close($fh);
    SKIP_SCHED:;

    #cat /proc/1/io 
    #rchar: 3432590242
    #wchar: 438665986
    #syscr: 316595
    #syscw: 104722
    #read_bytes: 1586438144
    #write_bytes: 246829056
    #cancelled_write_bytes: 7798784

    # parse /proc/<pid>/task/<tid>/io
    $file = '/proc/' . $pid . '/task/' . $tid . '/io';
    open($fh, $file) || goto SKIP_IO;
    LOOP_IO: while (<$fh>) {
      if (/^rchar:\s+(\S+)/) {
        $rchar = $1;
      } elsif (/^wchar:\s+(\S+)/) {
        $wchar = $1;
      } elsif (/^syscr:\s+(\S+)/) {
        $syscr = $1;
      } elsif (/^syscw:\s+(\S+)/) {
        $syscw = $1;
      } elsif (/^read_bytes:\s+(\S+)/) {
        $read_bytes = $1;
      } elsif (/^write_bytes:\s+(\S+)/) {
        $write_bytes = $1;
      } elsif (/^cancelled_write_bytes:\s+(\S+)/) {
        $cancelled_write_bytes = $1;
        $io_valid = 1;
        last LOOP_IO;
      }
    }
    close($fh);
    SKIP_IO:;

    # parse /proc/<pid>/task/<tid>/status
    $file = '/proc/' . $pid . '/task/' . $tid . '/status';
    open($fh, $file) || next;
    LOOP_STATUS: while (<$fh>) {
      if (/^Name:\s+(.*)/) {
        $comm = $1;
      } elsif (/^State:\s+(\S+)/) {
        $state = $1;
      } elsif (/^PPid:\s+(\S+)/) {
        $ppid = $1;
      } elsif (/^VmSize:\s+(\S+)/) {
        $VmSize = $1;
      } elsif (/^VmRSS:\s+(\S+)/) {
        $VmRSS = $1;
      } elsif (/^Cpus_allowed:\s+([0]+,)*(\S+)/) {
        my $h = $2; $h =~ tr/,/_/;
        $Cpus_allowed = Math::BigInt->from_hex($h);
        $affinity = $Cpus_allowed->band($::affinity_mask);
        $status_valid = 1;
        last LOOP_STATUS;
      }
    }
    close($fh);

    # parse /proc/<pid>/task/<tid>/cmdline
    $file = '/proc/' . $pid . '/task/' . $tid . '/cmdline';
    open($fh, $file) || next;
    LOOP_CMDLINE: while (<$fh>) {
      if (/^(.*)$/) {
        $cmdline = $1;
        $cmdline =~ s/\000/ /g;
        $cmdline_valid = 1;
        last LOOP_CMDLINE;
      }
    }
    if (!$cmdline_valid) {
      $cmdline_valid = 1;
      $cmdline = $comm;
    }
    close($fh);

    # parse /proc/<pid>/task/<tid>/wchan
    $file = '/proc/' . $pid . '/task/' . $tid . '/wchan';
    open($fh, $file) || next;
    LOOP_WCHAN: while (<$fh>) {
      if (/^(.*)$/) {
        $wchan = $1;
        $wchan_valid = 1;
        last LOOP_WCHAN;
      }
    }
    close($fh);

    #Table 1-4: Contents of the stat files (as of 2.6.30-rc7)
    #..............................................................................
    # Field          Content
    #  tpid          process id (or tid, if /proc/<pid>/task/<tid>/stat)
    #  tcomm         filename of the executable
    #  state         state (R is running, S is sleeping, D is sleeping in an
    #                uninterruptible wait, Z is zombie, T is traced or stopped)
    #  ppid          process id of the parent process
    #  pgrp          pgrp of the process
    #  sid           session id
    #  tty_nr        tty the process uses
    #  tty_pgrp      pgrp of the tty
    #  flags         task flags
    #  min_flt       number of minor faults
    #  cmin_flt      number of minor faults with child's
    #  maj_flt       number of major faults
    #  cmaj_flt      number of major faults with child's
    #  utime         user mode jiffies
    #  stime         kernel mode jiffies
    #  cutime        user mode jiffies with child's
    #  cstime        kernel mode jiffies with child's
    #  priority      priority level
    #  nice          nice level
    #  num_threads   number of threads
    #  it_real_value	(obsolete, always 0)
    #  start_time    time the process started after system boot
    #  vsize         virtual memory size
    #  rss           resident set memory size
    #  rsslim        current limit in bytes on the rss
    #  start_code    address above which program text can run
    #  end_code      address below which program text can run
    #  start_stack   address of the start of the main process stack
    #  esp           current value of ESP
    #  eip           current value of EIP
    #  pending       bitmap of pending signals
    #  blocked       bitmap of blocked signals
    #  sigign        bitmap of ignored signals
    #  sigcatch      bitmap of catched signals
    #  wchan         address where process went to sleep
    #  0             (place holder)
    #  0             (place holder)
    #  exit_signal   signal to send to parent thread on exit
    #  task_cpu      which CPU the task is scheduled on
    #  rt_priority   realtime priority
    #  policy        scheduling policy (man sched_setscheduler)
    #  blkio_ticks   time spent waiting for block IO
    #  gtime         guest time of the task in jiffies
    #  cgtime        guest time of the task children in jiffies
    #  start_data    address above which program data+bss is placed
    #  end_data      address below which program data+bss is placed
    #  start_brk     address above which program heap can be expanded with brk()
    #  arg_start     address above which program command line is placed
    #  arg_end       address below which program command line is placed
    #  env_start     address above which program environment is placed
    #  env_end       address below which program environment is placed
    #  exit_code     the thread's exit_code in the form reported by the waitpid system call
  
    # parse /proc/<pid>/task/<tid>/stat
    $file = '/proc/' . $pid . '/task/' . $tid . '/stat';
    my $dummy;
    open($fh, $file) || next;
    $_ = <$fh>;
    ($tpid, $tcomm, $dummy) = /^(\d+)\s+\((.*)\)\s+(.*)/;
    ($state, $ppid, $pgrp, $sid,
     $tty_nr, $tty_pgrp, $flags,
     $min_flt, $cmin_flt, $maj_flt, $cmaj_flt,
     $utime, $stime, $cutime, $cstime,
     $priority, $nice, $num_threads,
     $it_real_value, $start_time,
     $vsize, $rss, $rsslim,
     $start_code, $end_code, $start_stack, $esp, $eip,
     $pending, $blocked, $sigign, $sigcatch, $wchan_addr,
     $dum1, $dum2, $exit_signal, $task_cpu,
     $rt_priority, $policy, $blkio_ticks, $gtime, $cgtime,
     $start_data, $end_data, $start_brk, $arg_start, $arg_end,
     $env_start, $env_end, $exit_code) = split(/\s+/, $dummy);
    $stat_valid = 1;
    close($fh);

    # sched
    if (defined $sched_valid) {
      $::task{$tid}{'exec_runtime'}  = $exec_runtime;
      $::task{$tid}{'exec_max'}      = $exec_max;
      $::task{$tid}{'wait_max'}      = $wait_max;
      $::task{$tid}{'wait_sum'}      = $wait_sum;
      $::task{$tid}{'wait_count'}    = $wait_count;
      $::task{$tid}{'iowait_sum'}    = $iowait_sum;
      $::task{$tid}{'iowait_count'}  = $iowait_count;
      $::task{$tid}{'nr_migrations'} = $nr_migrations;
      $::task{$tid}{'nr_switches'}   = $nr_switches;
    } else {
      $::task{$tid}{'exec_runtime'}  = 0;
      $::task{$tid}{'exec_max'}      = 0;
      $::task{$tid}{'wait_max'}      = 0;
      $::task{$tid}{'wait_sum'}      = 0;
      $::task{$tid}{'wait_count'}    = 0;
      $::task{$tid}{'iowait_sum'}    = 0;
      $::task{$tid}{'iowait_count'}  = 0;
      $::task{$tid}{'nr_migrations'} = 0;
      $::task{$tid}{'nr_switches'}   = 0;
    }

    # io
    if (defined $io_valid) {
      $::task{$tid}{'rchar'} = $rchar;
      $::task{$tid}{'wchar'} = $wchar;
      $::task{$tid}{'syscr'} = $syscr;
      $::task{$tid}{'syscw'} = $syscw;
      $::task{$tid}{'read_bytes'}  = $read_bytes;
      $::task{$tid}{'write_bytes'} = $write_bytes;
      $::task{$tid}{'cancelled_write_bytes'} = $cancelled_write_bytes;
    } else {
      $::task{$tid}{'rchar'} = 0;
      $::task{$tid}{'wchar'} = 0;
      $::task{$tid}{'syscr'} = 0;
      $::task{$tid}{'syscw'} = 0;
      $::task{$tid}{'read_bytes'}  = 0;
      $::task{$tid}{'write_bytes'} = 0;
      $::task{$tid}{'cancelled_write_bytes'} = 0;
    }

    # status
    if (defined $status_valid) {
      $::task{$tid}{'pid'}      = $pid;
      $::task{$tid}{'comm'}     = $comm;
      $::task{$tid}{'state'}    = $state;
      $::task{$tid}{'ppid'}     = $ppid;
      $::task{$tid}{'VmSize'}   = $VmSize;
      $::task{$tid}{'VmRSS'}    = $VmRSS;
      $::task{$tid}{'affinity'} = $affinity;
    } else {
      $::task{$tid}{'pid'}      = 0;
      $::task{$tid}{'comm'}     = '-';
      $::task{$tid}{'state'}    = '-';
      $::task{$tid}{'ppid'}     = 0;
      $::task{$tid}{'VmSize'}   = 0;
      $::task{$tid}{'VmRSS'}    = 0;
      $::task{$tid}{'affinity'} = Math::BigInt->new('0');
    }

    # cmdline
    if (defined $cmdline_valid) {
      $::task{$tid}{'cmdline'} = $cmdline;
    } else {
      $::task{$tid}{'cmdline'} = $comm;
    }

    # wchan
    if (defined $cmdline_valid) {
      $::task{$tid}{'wchan'} = $wchan;
    } else {
      $::task{$tid}{'wchan'} = '-';
    }

    # stat
    if (defined $stat_valid) {
      $::task{$tid}{'nice'}        = $nice;
      $::task{$tid}{'policy'}      = $policy;
      $::task{$tid}{'priority'}    = $priority;
      $::task{$tid}{'rt_priority'} = $rt_priority;
      $::task{$tid}{'start_time'}  = $start_time;
      $::task{$tid}{'task_cpu'}    = $task_cpu;
    } else {
      $::task{$tid}{'nice'}        = 0;
      $::task{$tid}{'policy'}      = '-';
      $::task{$tid}{'priority'}    = 0;
      $::task{$tid}{'rt_priority'} = 0;
      $::task{$tid}{'start_time'}  = '';
      $::task{$tid}{'task_cpu'}    = 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);
  SKIP_SCHED:;
}

# 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, local *::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 header
sub schedtop_header {
  (local *::tr_1,
   local *::tm_elapsed,
   local *::tr_elapsed,
   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;

  # Calculate skew of CLOCK_REALTIME vs CLOCK_MONOTONIC,
  # and display skew if > 5% relative difference.
  my $skew_ms = ($::tr_elapsed - $::tm_elapsed)*1000.0;
  my $skew = "";
  if (abs($skew_ms)/$::tm_elapsed > 50.0) {
    $skew = sprintf " skew:%.3f ms", $skew_ms;
  }

  #schedtop -- 2014/03/03 02:00:21.357  dt:2050.003 ms  ldavg:0.07, 0.09, 0.08  runq:1  blk:0  nproc:440  up:6:13:00:56  skew:0.001 ms
  printf "%s %s -- ".
    "%4d-%02d-%02d %02d:%02d:%02d.%03d  ".
    "dt:%.3f ms  ".
    "ldavg:%.2f, %.2f, %.2f  runq:%d  blk:%d  nproc:%d  ".
    "up:%d:%02d:%02d:%02d %s\n",
    $::TOOLNAME, $::VERSION,
    1900+$year, 1+$mon, $mday, $hour, $min, $sec, $msec,
    $::tm_elapsed*1000.0,
    $::loadavg{'1'}, $::loadavg{'5'}, $::loadavg{'15'},
    $::runq, $::num_blk, $::num_tasks,
    $up_dd, $up_hh, $up_mm, $up_ss,
    $skew;

  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_schedtop_args {
  (local *::arg_debug,
   local *::arg_delay,
   local *::arg_repeat,
   local *::arg_period,
   local *::arg_reset_hwm,
   local *::arg_idle,
   local *::arg_sort,
   local *::arg_print,
  ) = @_;
 
  # 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,
    "reset-hwm",   \$::arg_reset_hwm,
    "idle",        \$::arg_idle,
    "sort=s",      \$::arg_sort,
    "print=s",     \$::arg_print,
    "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 ((defined $::arg_sort) && !(($::arg_sort eq 'cpu') || ($::arg_sort eq 'io'))) {
    $fail = 1;
    warn "$::TOOLNAME: Input error: --sort=$::arg_sort invalid; valid options are: cpu, io.\n";
  }
  if ((defined $::arg_print) && !(($::arg_print eq 'brief') || ($::arg_print eq 'full'))) {
    $fail = 1;
    warn "$::TOOLNAME: Input error: --print=$::arg_print invalid; valid options are: brief, full\n";
  }
  if (@::ARGV) {
    $fail = 1;
    warn "$::TOOLNAME: Input error: not expecting these options: '@::ARGV'.\n";
  }

  # Set reasonable defaults
  $::arg_delay  ||= 1.0;
  $::arg_repeat ||= 1;
  if ($::arg_period) {
    $::arg_repeat = $::arg_period / $::arg_delay;
  } else {
    $::arg_period = $::arg_delay * $::arg_repeat;
  }
  $::arg_sort ||= 'cpu';
  $::arg_print ||= 'full';

  # 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 " [--reset-hwm] [--idle] [--sort=<cpu|io>] [--print=<brief|full>]\n";
  printf " [--help]\n";

  printf "\n"; 
}

# Print tool help
sub ListHelp {
  printf "$::TOOLNAME -- display per-task scheduling 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 " --reset-hwm        : reset scheduling delay hi-water marks\n";
  printf " --idle             : specify printing of idle tasks\n";
  printf " --sort=<cpu|io>    : sort order, select from 'cpu' or 'io'\n";
  printf " --print=<brief|full> : select 'brief' or 'full' fields to display\n";
  printf " --help             : this help\n";
  exit 0;
}

1;