Commit bcefe12e authored by Tom Zanussi's avatar Tom Zanussi Committed by Ingo Molnar
Browse files

perf trace: Add perf trace scripting support modules for Perl



Add Perf-Trace-Util Perl module and some scripts that use it.
Core.pm contains Perl code to define and access flag and
symbolic fields. Util.pm contains general-purpose utility
functions.

Also adds some makefile bits to install them in
libexec/perf-core/scripts/perl (or wherever perfexec_instdir
points).

Signed-off-by: default avatarTom Zanussi <tzanussi@gmail.com>
Cc: fweisbec@gmail.com
Cc: rostedt@goodmis.org
Cc: anton@samba.org
Cc: hch@infradead.org
LKML-Reference: <1259133352-23685-5-git-send-email-tzanussi@gmail.com>
Signed-off-by: default avatarIngo Molnar <mingo@elte.hu>
parent 16c632de
......@@ -980,6 +980,13 @@ export perfexec_instdir
install: all
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'
$(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)'
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
$(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
$(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl'
$(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
$(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
$(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
ifdef BUILT_INS
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
$(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
......
use 5.010000;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
NAME => 'Perf::Trace::Util',
VERSION_FROM => 'lib/Perf/Trace/Util.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/Perf/Trace/Util.pm', # retrieve abstract from module
AUTHOR => 'Tom Zanussi <tzanussi@gmail.com>') : ()),
);
Perf-Trace-Util version 0.01
============================
This module contains utility functions for use with perf trace.
INSTALLATION
Building perf with perf trace Perl scripting should install this
module in the right place.
You should make sure libperl is installed first e.g. apt-get install
libperl-dev.
DEPENDENCIES
This module requires these other modules and libraries:
blah blah blah
COPYRIGHT AND LICENCE
Put the correct copyright and licence information here.
Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com>
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.
Alternatively, this software may be distributed under the terms of the
GNU General Public License ("GPL") version 2 as published by the Free
Software Foundation.
package Perf::Trace::Core;
use 5.010000;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
define_flag_field define_flag_value flag_str dump_flag_fields
define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
);
our $VERSION = '0.01';
my %flag_fields;
my %symbolic_fields;
sub flag_str
{
my ($event_name, $field_name, $value) = @_;
my $string;
if ($flag_fields{$event_name}{$field_name}) {
my $print_delim = 0;
foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
if (!$value && !$idx) {
$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
last;
}
if ($idx && ($value & $idx) == $idx) {
if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
$string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
}
$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
$print_delim = 1;
$value &= ~$idx;
}
}
}
return $string;
}
sub define_flag_field
{
my ($event_name, $field_name, $delim) = @_;
$flag_fields{$event_name}{$field_name}{"delim"} = $delim;
}
sub define_flag_value
{
my ($event_name, $field_name, $value, $field_str) = @_;
$flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
}
sub dump_flag_fields
{
for my $event (keys %flag_fields) {
print "event $event:\n";
for my $field (keys %{$flag_fields{$event}}) {
print " field: $field:\n";
print " delim: $flag_fields{$event}{$field}{'delim'}\n";
foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
}
}
}
}
sub symbol_str
{
my ($event_name, $field_name, $value) = @_;
if ($symbolic_fields{$event_name}{$field_name}) {
foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
if (!$value && !$idx) {
return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
last;
}
if ($value == $idx) {
return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
}
}
}
return undef;
}
sub define_symbolic_field
{
my ($event_name, $field_name) = @_;
# nothing to do, really
}
sub define_symbolic_value
{
my ($event_name, $field_name, $value, $field_str) = @_;
$symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
}
sub dump_symbolic_fields
{
for my $event (keys %symbolic_fields) {
print "event $event:\n";
for my $field (keys %{$symbolic_fields{$event}}) {
print " field: $field:\n";
foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
}
}
}
}
1;
__END__
=head1 NAME
Perf::Trace::Core - Perl extension for perf trace
=head1 SYNOPSIS
use Perf::Trace::Core
=head1 SEE ALSO
Perf (trace) documentation
=head1 AUTHOR
Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 by Tom Zanussi
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.
Alternatively, this software may be distributed under the terms of the
GNU General Public License ("GPL") version 2 as published by the Free
Software Foundation.
=cut
package Perf::Trace::Util;
use 5.010000;
use strict;
use warnings;
require Exporter;
our @ISA = qw(Exporter);
our %EXPORT_TAGS = ( 'all' => [ qw(
) ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs
);
our $VERSION = '0.01';
sub avg
{
my ($total, $n) = @_;
return $total / $n;
}
my $NSECS_PER_SEC = 1000000000;
sub nsecs
{
my ($secs, $nsecs) = @_;
return $secs * $NSECS_PER_SEC + $nsecs;
}
sub nsecs_secs {
my ($nsecs) = @_;
return $nsecs / $NSECS_PER_SEC;
}
sub nsecs_nsecs {
my ($nsecs) = @_;
return $nsecs - nsecs_secs($nsecs);
}
sub nsecs_str {
my ($nsecs) = @_;
my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));
return $str;
}
1;
__END__
=head1 NAME
Perf::Trace::Util - Perl extension for perf trace
=head1 SYNOPSIS
use Perf::Trace::Util;
=head1 SEE ALSO
Perf (trace) documentation
=head1 AUTHOR
Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009 by Tom Zanussi
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.10.0 or,
at your option, any later version of Perl 5 you may have available.
Alternatively, this software may be distributed under the terms of the
GNU General Public License ("GPL") version 2 as published by the Free
Software Foundation.
=cut
#!/usr/bin/perl -w
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
# Display r/w activity for files read/written to for a given program
# The common_* event handler fields are the most useful fields common to
# all events. They don't necessarily correspond to the 'common_*' fields
# in the status files. Those fields not available as handler params can
# be retrieved via script functions of the form get_common_*().
use 5.010000;
use strict;
use warnings;
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
use lib "./Perf-Trace-Util/lib";
use Perf::Trace::Core;
use Perf::Trace::Util;
# change this to the comm of the program you're interested in
my $for_comm = "perf";
my %reads;
my %writes;
sub syscalls::sys_enter_read
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
if ($common_comm eq $for_comm) {
$reads{$fd}{bytes_requested} += $count;
$reads{$fd}{total_reads}++;
}
}
sub syscalls::sys_enter_write
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
if ($common_comm eq $for_comm) {
$writes{$fd}{bytes_written} += $count;
$writes{$fd}{total_writes}++;
}
}
sub trace_end
{
printf("file read counts for $for_comm:\n\n");
printf("%6s %10s %10s\n", "fd", "# reads", "bytes_requested");
printf("%6s %10s %10s\n", "------", "----------", "-----------");
foreach my $fd (sort {$reads{$b}{bytes_requested} <=>
$reads{$a}{bytes_requested}} keys %reads) {
my $total_reads = $reads{$fd}{total_reads};
my $bytes_requested = $reads{$fd}{bytes_requested};
printf("%6u %10u %10u\n", $fd, $total_reads, $bytes_requested);
}
printf("\nfile write counts for $for_comm:\n\n");
printf("%6s %10s %10s\n", "fd", "# writes", "bytes_written");
printf("%6s %10s %10s\n", "------", "----------", "-----------");
foreach my $fd (sort {$writes{$b}{bytes_written} <=>
$writes{$a}{bytes_written}} keys %writes) {
my $total_writes = $writes{$fd}{total_writes};
my $bytes_written = $writes{$fd}{bytes_written};
printf("%6u %10u %10u\n", $fd, $total_writes, $bytes_written);
}
print_unhandled();
}
my %unhandled;
sub print_unhandled
{
if ((scalar keys %unhandled) == 0) {
return;
}
print "\nunhandled events:\n\n";
printf("%-40s %10s\n", "event", "count");
printf("%-40s %10s\n", "----------------------------------------",
"-----------");
foreach my $event_name (keys %unhandled) {
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
}
}
sub trace_unhandled
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm) = @_;
$unhandled{$event_name}++;
}
#!/usr/bin/perl -w
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
# Display r/w activity for all processes
# The common_* event handler fields are the most useful fields common to
# all events. They don't necessarily correspond to the 'common_*' fields
# in the status files. Those fields not available as handler params can
# be retrieved via script functions of the form get_common_*().
use 5.010000;
use strict;
use warnings;
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
use lib "./Perf-Trace-Util/lib";
use Perf::Trace::Core;
use Perf::Trace::Util;
my %reads;
my %writes;
sub syscalls::sys_exit_read
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$nr, $ret) = @_;
if ($ret > 0) {
$reads{$common_pid}{bytes_read} += $ret;
} else {
if (!defined ($reads{$common_pid}{bytes_read})) {
$reads{$common_pid}{bytes_read} = 0;
}
$reads{$common_pid}{errors}{$ret}++;
}
}
sub syscalls::sys_enter_read
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$nr, $fd, $buf, $count) = @_;
$reads{$common_pid}{bytes_requested} += $count;
$reads{$common_pid}{total_reads}++;
$reads{$common_pid}{comm} = $common_comm;
}
sub syscalls::sys_exit_write
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$nr, $ret) = @_;
if ($ret <= 0) {
$writes{$common_pid}{errors}{$ret}++;
}
}
sub syscalls::sys_enter_write
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$nr, $fd, $buf, $count) = @_;
$writes{$common_pid}{bytes_written} += $count;
$writes{$common_pid}{total_writes}++;
$writes{$common_pid}{comm} = $common_comm;
}
sub trace_end
{
printf("read counts by pid:\n\n");
printf("%6s %20s %10s %10s %10s\n", "pid", "comm",
"# reads", "bytes_requested", "bytes_read");
printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------",
"-----------", "----------", "----------");
foreach my $pid (sort {$reads{$b}{bytes_read} <=>
$reads{$a}{bytes_read}} keys %reads) {
my $comm = $reads{$pid}{comm};
my $total_reads = $reads{$pid}{total_reads};
my $bytes_requested = $reads{$pid}{bytes_requested};
my $bytes_read = $reads{$pid}{bytes_read};
printf("%6s %-20s %10s %10s %10s\n", $pid, $comm,
$total_reads, $bytes_requested, $bytes_read);
}
printf("\nfailed reads by pid:\n\n");
printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
printf("%6s %20s %6s %10s\n", "------", "--------------------",
"------", "----------");
foreach my $pid (keys %reads) {
my $comm = $reads{$pid}{comm};
foreach my $err (sort {$reads{$b}{comm} cmp $reads{$a}{comm}}
keys %{$reads{$pid}{errors}}) {
my $errors = $reads{$pid}{errors}{$err};
printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
}
}
printf("\nwrite counts by pid:\n\n");
printf("%6s %20s %10s %10s\n", "pid", "comm",
"# writes", "bytes_written");
printf("%6s %-20s %10s %10s\n", "------", "--------------------",
"-----------", "----------");
foreach my $pid (sort {$writes{$b}{bytes_written} <=>
$writes{$a}{bytes_written}} keys %writes) {
my $comm = $writes{$pid}{comm};
my $total_writes = $writes{$pid}{total_writes};
my $bytes_written = $writes{$pid}{bytes_written};
printf("%6s %-20s %10s %10s\n", $pid, $comm,
$total_writes, $bytes_written);
}
printf("\nfailed writes by pid:\n\n");
printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
printf("%6s %20s %6s %10s\n", "------", "--------------------",
"------", "----------");
foreach my $pid (keys %writes) {
my $comm = $writes{$pid}{comm};
foreach my $err (sort {$writes{$b}{comm} cmp $writes{$a}{comm}}
keys %{$writes{$pid}{errors}}) {
my $errors = $writes{$pid}{errors}{$err};
printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
}
}
print_unhandled();
}
my %unhandled;
sub print_unhandled
{
if ((scalar keys %unhandled) == 0) {
return;
}
print "\nunhandled events:\n\n";
printf("%-40s %10s\n", "event", "count");
printf("%-40s %10s\n", "----------------------------------------",
"-----------");
foreach my $event_name (keys %unhandled) {
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
}
}
sub trace_unhandled
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm) = @_;
$unhandled{$event_name}++;
}
#!/usr/bin/perl -w
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
# Display avg/min/max wakeup latency
# The common_* event handler fields are the most useful fields common to
# all events. They don't necessarily correspond to the 'common_*' fields
# in the status files. Those fields not available as handler params can
# be retrieved via script functions of the form get_common_*().
use 5.010000;
use strict;
use warnings;
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
use lib "./Perf-Trace-Util/lib";