Diagnosing power usage with ZZZtop

Code:
#!/usr/bin/perl -w



# Zzztop.pl

#

# Copyright 2013, Phil Carmody

# Inspired by "PowerTOP", but renamed as it's more concerned with

# sleeping than it is with the actual power consumed. Detects tasks

# that prevent the system from sleeping, in particular those that

# poll files or incorrectly poll() them, and ones that play ping-pong

# with each other.





# This program is free software: you can redistribute it and/or modify

# it under the terms of the GNU General Public License as published by

# the Free Software Foundation, version 3.

#

# This program is distributed in the hope that it will be useful,

# but WITHOUT ANY WARRANTY; without even the implied warranty of

# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

# GNU General Public License for more details. This can be found

# at <http://www.gnu.org/licenses/>.





use strict qw(refs vars subs);

use warnings;



my $verbose=1;

my $all=0; # show all frequencies (etc.?) even if data is 0

my $incompat=0; # more accuracy then maemo/meego's powertop means different results



# Need to select which timer to use. Time::HiRes may not be available

my ($xtime,$calibrate);

eval { require Time::HiRes; };

if(!$@) { $xtime = \&Time::HiRes::time; }

else {

    print STDERR "WARNING: Only low accuracy timing available.\n";

    sub xtime {

    open(S, "</proc/stat");

    <S>; $_=<S>;

    close(S);

    my @a=split(/\s+/);

    return ($a[1]+$a[2]+$a[3]+$a[4]+$a[5]+$a[6]+$a[7])/100;

    }

    $xtime=\&xtime;

    $calibrate=1; 

}



# Not every check is appropriate, depending on platform

my ($do_cpuidle, $do_cpufreq, $do_interrupts, $do_timerstats, $do_ctxtsw)=(1,1,1,1,1);



sub usage()

{

    print<<HELP

ZzzTop: show wakeup reasons, and other PM-related CPU info

Usage:

zzztop [-h] [-s=<nnn>] [-t=<nnn>] [-a]

  -h       this help text

  -s=<nnn> sleep for <nnn> seconds before collecting data

  -t=<nnn> collect data for <nnn> seconds

  -a       for some data gathered (cpufreq), show even 0 records

HELP

}



my ($sleep,$time)=(10,30);

while($_=shift(@ARGV)) {

    if(m/-s=(\d+)/) { $sleep=int($1); }

    elsif(m/-t=(\d+)/) { $time=int($1); }

    elsif(m/-a/) { $all=1; }

    elsif(m/-h/) { usage(); exit; }

    else { unshift(@ARGV, $_); last; }

}



my $mtime;

# gmtime(); # flush any one-time-only date prep now before the critical loop



my $cpudir='/sys/devices/system/cpu';



sub headstrip($)

{

    open(F, "<", $_[0]) or die("failed to read $_[0]");

    $_=<F>;

    close(F);

    chomp if($_);

    $_;

}



# BEGIN cpu

sub get_cpu_range()

{

    my $c=-1;

    my @cpus=glob("$cpudir/cpu[0-9]");

    foreach my $cpuname (@cpus) {

    my ($cpu)=($cpuname=~m/(\d+)$/);

    if($cpu>$c) { $c=$cpu; }

    }

    print("Detected ".($c+1)." cpus\n")

    if($verbose);

    $c;

}



my $maxcpu=0;

$maxcpu = get_cpu_range();

if($maxcpu<0) {

    $do_cpuidle=0;

    print STDERR "All cpu-specific data gathering disabled - no $cpudir/cpu*\n";

}

# END cpu



# BEGIN cpuidle

sub get_cpuidle_ranges($)

{

    my $ret=$_[0];

    my $s=-1;

    foreach my $cpu (0..$maxcpu) {

    my @states=glob("$cpudir/cpu$cpu/cpuidle/state[0-9]*");

    my $t=-1;

    foreach my $state (@states) {

        my ($statenum)=($state =~ m/(\d+)$/);

        if($statenum>$t) { $t=$statenum; }

    }

    if($t>=0) { $ret->[$cpu]=$t; }

    if($t>$s) { $s=$t; }

    }

    print("Detected ".($s+1)." cpuidle states (@$ret)\n")

    if($verbose);

    $s;

}



my @maxstate;

my $maxstate = get_cpuidle_ranges(\@maxstate);

if($#maxstate<0) {

    $do_cpuidle=0;

    print STDERR "cpuidle disabled - no $cpudir/cpu*/cpuidle trees\n";

    print STDERR "                   enable CPU_IDLE in kernel config\n"

    if($verbose);

}



sub get_cpuidle_data() {

    my @ret=();

    foreach my $cpu (0..$maxcpu) {

    $ret[$cpu]=[];

    foreach my $state (0..$maxstate[$cpu]) {

        my $time=headstrip("$cpudir/cpu$cpu/cpuidle/state$state/time");

        my $usage=headstrip("$cpudir/cpu$cpu/cpuidle/state$state/usage");

        $ret[$cpu]->[$state]=[$time,$usage];

    }

    }

    @ret;

}



sub diff_cpuidle($$)

{

    my ($pre, $post)=@_;

    print("C-state Information\n");

    print("===================\n");

    

    my @totalidle=();

    my $usagemax=0;

    foreach my $cpu (0..$maxcpu) {

    foreach my $state (0..$maxstate[$cpu]) {

        my $dt = $post->[$cpu][$state][0] - $pre->[$cpu][$state][0];

        my $du = $post->[$cpu][$state][1] - $pre->[$cpu][$state][1];

        $totalidle[$cpu] += $dt;

        my $residence = $du ? int($dt/$du) : 0;

        if($residence > $usagemax) { $usagemax=$residence; }

    }

    }

    my ($usagescale, $usageletter)=(1,'u');

    if($usagemax>99999) { $usagescale=1000; $usageletter='m'; }



    my ($h1,$h2,$h3);

    $h1="    |";

    $h2=" C# |";

    $h3="----+";

    foreach my $cpu (0..$maxcpu) {

    $h1.="      CPU#$cpu      |";

    $h2.="  time  | avg/${usageletter}s |";

    $h3.="--------+--------+";

    }

    print("$h1\n$h2\n$h3\n");



    printf(" C%u |", 0); # active is the fake state C0

    foreach my $cpu (0..$maxcpu) {

    printf(" %5.1f%% |        |", 100-$totalidle[$cpu]/($mtime*10000));

    }

    print("\n");

    foreach my $state (0..$maxstate) {

    printf(" C%u |", $state+1);

    foreach my $cpu (0..$maxcpu) {

        if($state<=$maxstate[$cpu]) {

        my $dt = $post->[$cpu][$state][0] - $pre->[$cpu][$state][0];

        my $du = $post->[$cpu][$state][1] - $pre->[$cpu][$state][1];

        # times in us, so divide by 1000000, but want % so use 10000.

        # usage is number of transition

        printf(" %5.1f%% |  % 5s |", 

               $dt/($mtime*10000),

               $du ? int($dt/$du/$usagescale) : "");

        } else {

        printf("        |        |");

        }

    }

    print("\n");

    }

    #With the fake C0 record for active, there's no need for the idle sum too

    #print("Idle\t|");

    #foreach my $cpu (0..$maxcpu) {

    #    printf(" %4.1f%%\t|\t|", $totalidle[$cpu]/($mtime*10000));

    #}

    #print("\n");

    print("\n");

}

# END cpuidle



# BEGIN cpufreq

sub get_cpufreq_ranges()

{

    return -r "$cpudir/cpu0/cpufreq/stats/time_in_state" ? 0 : -1;

}



if(get_cpufreq_ranges()<0) {

    $do_cpufreq = 0;

    print STDERR "cpufreq disabled - no $cpudir/cpu*/cpufreq/stats/time_in_state\n";

    print STDERR "                   enable CPU_FREQ_STAT in kernel config\n"

    if($verbose);

}



sub get_cpufreq_data() {

    my @ret=();

    foreach my $cpu (0..$maxcpu) {

    $ret[$cpu]={};

    open(F, "<$cpudir/cpu$cpu/cpufreq/stats/time_in_state") or die("cpufreq: 'read $cpudir/cpu$cpu/cpufreq/stats/time_in_state' $@");

    while(<F>) {

        if(m/(\d+)\s+(\d+)/) { $ret[$cpu]->{$1} = $2; }

        else { die("WTF is this doing in cpufreq: $_"); }

    }

    close(F);

    # print("cpu$cpu -> ", join(" ",keys(%{$ret[$cpu]})), "\n");

    }

    @ret;

}



sub diff_cpufreq($$)

{

    my ($pre, $post)=(@_);

    my %okfreq=();

    print("CPUfreq statistics\n");

    print("==================\n");

    my @totalticks=();

    my @freqs = sort { $a<=>$b } keys(%{$pre->[0]});

    foreach my $cpu (0..$maxcpu) {

    $totalticks[$cpu]=0;

    foreach my $freq (@freqs) {

        my $dt = $post->[$cpu]->{$freq} - $pre->[$cpu]->{$freq};

        $totalticks[$cpu] += $dt;

        if($dt) { $okfreq{$freq}++; }

    }

    }



    my $h1="Frequency |";

    my $h2="----------+";

    foreach my $cpu (0..$maxcpu) {

    $h1.="  CPU#$cpu |";

    $h2.="--------+";

    }

    print("$h1\n$h2\n");

    

    foreach my $freq (@freqs) {

    if(!$all and !$okfreq{$freq}) { next; }

    printf(" %4u MHz |", int($freq/1000));

    foreach my $cpu (0..$maxcpu) {

        my $dt = $post->[$cpu]->{$freq} - $pre->[$cpu]->{$freq};

        printf(" %5.1f%% |", $dt*100/$totalticks[$cpu]);

    }

    print("\n");

    }

    print("\n");

}

        

# END cpufreq



# BEGIN interrupts

sub get_interrupt_names()

{

    open(I, "</proc/interrupts") or return undef;

    my @ret=();

    while(<I>) {

    if(m/^\s+CPU\d/) { next; }

    elsif(m/\s*(\w+):\s+\d/) { push(@ret, $1); }

    else { print("interrupts: what's: $_"); }

    }

    close(I);

    @ret;

}



my @interrupt_names=get_interrupt_names();

if(scalar(@interrupt_names)<=0) {

    $do_interrupts = 0;

    print STDERR "interrupts disabled - no /proc/interrupts\n";

}



sub get_interrupt_data() {

    my @ret=();

    open(I, "</proc/interrupts");

    while(<I>) {

    if(m/^\s+CPU\d/) {

        foreach my $cpu (0..$maxcpu+1) { $ret[$cpu]={}; }

        next;

    } elsif(s/\s*([\w]+):\s+//) {

        my $int=$1;

        foreach my $cpu (0..$maxcpu) {

        s/(\d+)\s+//;

        if($maxcpu>0 && !length($_)) { last; }

        $ret[$cpu]->{$int}=$1; 

        }

        chomp;

        $ret[$maxcpu+1]->{$int} = $_;

    }

    else { print("interrupts: what's: $_"); }

    }

    close(I);

    @ret;

}



sub diff_interrupts($$)

{

    my ($pre, $post)=(@_);

    my %okirq=();

    my @output=();

    my @activity=();

    my $total=0;



    foreach my $int (@interrupt_names) {

    if($maxcpu>0 and !exists($pre->[1]->{$int})) { next; } # ERR or MIS, cpu-less

    my $line=sprintf("%4s |", $int);

    my $doit=0;

    foreach my $cpu (0..$maxcpu) {

        my $dt = $post->[$cpu]->{$int} - $pre->[$cpu]->{$int};

        $line.=sprintf(" % 5u |", $dt);

        $doit+=$dt;

    }

    if($doit) { 

        push(@output, "$line $pre->[$maxcpu+1]->{$int}\n"); 

        push(@activity, $doit); 

        $total+=$doit;

    }

    }



    print("Interrupt statistics\n");

    print("====================\n");



    my $h1=" INT |";

    my $h2="-----+";

    foreach my $cpu (0..$maxcpu) {

    $h1.=" CPU#$cpu |";

    $h2.="-------+";

    }

    print("$h1\n$h2\n");

    my @indices = sort { $activity[$b]<=>$activity[$a]; } (0..$#activity);

    foreach(@indices) { print($output[$_]); }

    printf("Summary: %3.1f interrupts/s total\n", $total/$mtime);

    print("\n");

}

# END interrupts



# BEGIN timerstats

sub get_timerstats()

{

    open(T, ">/proc/timer_stats") or return -1;

    print T "0\n";

    close(T);

    0;

}



if(get_timerstats()<0) {

    $do_timerstats = 0;

    print STDERR "timerstats disabled - no writeable /proc/timer_stats\n";

    if($> != 0) { print STDERR "                      you need to be root!\n"; }

    elsif($verbose) {

    print STDERR "                      enable TIMER_STATS in kernel config\n";

    }

}



sub get_timerstats_data($) # 1 then 0

{

    my $stop=$_[0];

    open(T, ">/proc/timer_stats") or die("timerstats: open() failed: $@");

    print T (($stop?1:0),"\n");

    close(T);

}



sub diff_timerstats()

{

    my $ok=1;

    my @output=();

    my @activity=();

    open(T, "</proc/timer_stats") or die("timerstats: open() failed: $@");

    while(<T>) {

    if(m/Timer Stats Version/) { next; }

    if(m/Sample period: ([\d.]+)\s*s/) { if($1 eq "0.000") { $ok=0; last; } }

    if(m/(\d+) total events/) { if($1 eq "0") { $ok=0; last; } }

    if(m/\s+(\d+)(D?),\s+(\d+)\s(\S+)\s+(.*)$/) {

        push(@output, sprintf(" % 5s | % 8s%1s| % 15s | %s\n",

                  $3, $1, $2, $4, $5));

        push(@activity, $1+($3*10e-9)); # decimals keep tasks together ;-)

    }

    }

    close(T);

    if(!$ok) {

    print("Timerstats was unable to gather any data from /proc/timer_stats\n\n");

    return;

    }

    my @indices = sort { $activity[$b]<=>$activity[$a]; } (0..$#activity);

    print("Timer statistics\n");

    print("================\n");

    print("   PID | Activity |     task's comm | function\n");

    print("-------+----------+-----------------+---------\n");

    foreach(@indices) { print($output[$_]); }

    print("\n");

}

# END timerstats



my %taskinfo=();

my $taskinfodone=0;

sub get_task_info($)

{

    my $cmd=headstrip("/proc/$_[0]/cmdline");

    if($cmd) {

    $cmd=~tr/\0/ /;

    }

    $cmd;

}

sub get_tasks_info($) {

    if(!$_[0] and $taskinfodone) { return; }

    for my $p (glob("/proc/[0-9]*")) {

    my ($pid)=($p=~m@/proc/(\d+)@);

    $taskinfo{$pid}=get_task_info($pid);

    }

}



# BEGIN context switch stats

sub get_ctxtsw_init()

{

    get_tasks_info(0);

    0;

}

if(get_ctxtsw_init() < 0) {

    $do_ctxtsw = 0;

    print STDERR "context_switches disabled - this is unexpected\n";

}



sub get_ctxtsw_data()

{

    my %ret=();

    for my $p (glob("/proc/[0-9]*")) {

    open(T, "$p/status") or next;

    my ($pid)=($p=~m@/proc/(\d+)@);

    my @v=();

    my $luserspace=0;

    my ($name)=(<T>=~/Name:\s+(\S+)/);

    while(<T>) {

        if(m/^(Vm|State:\s+Z)/) { $luserspace=1; }

        elsif(m/(\S*)voluntary_ctxt_switches:\s+(\d+)/) {

        $v[length($1)?1:0] = $2;

        }

    }

    if(!defined($taskinfo{$pid})) {

        $taskinfo{$pid} = $luserspace ? get_task_info($pid) : "<$name>";

    }

    close(T);

    $ret{$pid}=\@v;

    }

    %ret;

}

sub diff_ctxtsw($$)

{

    my ($pre, $post)=@_;

    print("Context switches per task\n",

      "=========================\n");

    print("  PID  | vol'try | non-vol | Cmdline\n",

      "-------+---------+---------+--------\n");

    my @postpids=sort { $b<=>$a; } (keys(%$post));

    foreach my $p (@postpids) {

    my $prevals = $pre->{$p} || [0,0];

    my $dv=$post->{$p}->[0] - $prevals->[0];

    my $dn=$post->{$p}->[1] - $prevals->[1];

    printf(" % 5u | % 7u | % 7u | %s\n", $p, $dv, $dn, $taskinfo{$p})

        if($dv || $dn);

    }

    print("\n");

}

# END context switch stats



if(!$do_cpuidle && !$do_cpufreq && !$do_interrupts && !$do_timerstats && !$do_ctxtsw) {

    print "No statistics can be gathered, aborting\n";

    exit;

}



# Timing preparations

print("Sleeping for $sleep seconds before collecting data for $time seconds\n");

my ($timepre1, $timepre2, $timepost1, $timepost2);

my $timecali=&$xtime if($calibrate);

sleep($sleep);

$timepre1=&$xtime;

if($sleep and $calibrate) {

    my $measured=$timepre1-$timecali;

    my $ratio=$measured/$sleep;

    if($ratio>1.01 or $ratio<0.99) { print("WARNING: No accurate timer found, relying on sleep itself.\n"); }

    else { $calibrate=0; } # we trust this measure

}



# Now actually gather the data

my %ctxtsw_pre=get_ctxtsw_data() if($do_ctxtsw);

my @cpuidle_pre=get_cpuidle_data() if($do_cpuidle);

my @cpufreq_pre=get_cpufreq_data() if($do_cpufreq);

my @interrupts_pre=get_interrupt_data() if($do_interrupts);

get_timerstats_data(1) if($do_timerstats);

$timepre2=&$xtime;

sleep($time);

$timepost1=&$xtime;

my %ctxtsw_post=get_ctxtsw_data() if($do_ctxtsw);

my @cpuidle_post=get_cpuidle_data() if($do_cpuidle);

my @cpufreq_post=get_cpufreq_data() if($do_cpufreq);

my @interrupts_post=get_interrupt_data() if($do_interrupts);

get_timerstats_data(0) if($do_timerstats);

$timepost2=&$xtime;



# @$mtime is the measurement time, which will probably be

#         longer than the time we requested.

if($calibrate) {

    $mtime = $time;

    printf("Presumably slept for %1.3fs\n", $mtime);

} else {

    $mtime =($timepost1-$timepre2); # how long the sleep took

    $mtime += (($timepre2-$timepre1)+($timepost2-$timepost1))/2 

    if($incompat); # plus the overhead of reading the values

    printf("Actually slept for %1.3fs\n", $mtime);

}



diff_cpuidle(\@cpuidle_pre, \@cpuidle_post) if($do_cpuidle);

diff_cpufreq(\@cpufreq_pre, \@cpufreq_post) if($do_cpufreq);

diff_interrupts(\@interrupts_pre, \@interrupts_post) if($do_interrupts);

diff_timerstats() if($do_timerstats);

diff_ctxtsw(\%ctxtsw_pre, \%ctxtsw_post) if($do_ctxtsw);