M7350v1_en_gpl

This commit is contained in:
T
2024-09-09 08:52:07 +00:00
commit f9cc65cfda
65988 changed files with 26357421 additions and 0 deletions

View File

@@ -0,0 +1,135 @@
/*
* This file was generated automatically by ExtUtils::ParseXS version 2.18_02 from the
* contents of Context.xs. Do not edit this file, edit Context.xs instead.
*
* ANY CHANGES MADE HERE WILL BE LOST!
*
*/
#line 1 "Context.xs"
/*
* Context.xs. XS interfaces for perf script.
*
* Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
*
* 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; either version 2 of the License, or
* (at your option) any later version.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "../../../perf.h"
#include "../../../util/trace-event.h"
#ifndef PERL_UNUSED_VAR
# define PERL_UNUSED_VAR(var) if (0) var = var
#endif
#line 42 "Context.c"
XS(XS_Perf__Trace__Context_common_pc); /* prototype to pass -Wmissing-prototypes */
XS(XS_Perf__Trace__Context_common_pc)
{
#ifdef dVAR
dVAR; dXSARGS;
#else
dXSARGS;
#endif
if (items != 1)
Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_pc", "context");
PERL_UNUSED_VAR(cv); /* -W */
{
struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
int RETVAL;
dXSTARG;
RETVAL = common_pc(context);
XSprePUSH; PUSHi((IV)RETVAL);
}
XSRETURN(1);
}
XS(XS_Perf__Trace__Context_common_flags); /* prototype to pass -Wmissing-prototypes */
XS(XS_Perf__Trace__Context_common_flags)
{
#ifdef dVAR
dVAR; dXSARGS;
#else
dXSARGS;
#endif
if (items != 1)
Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_flags", "context");
PERL_UNUSED_VAR(cv); /* -W */
{
struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
int RETVAL;
dXSTARG;
RETVAL = common_flags(context);
XSprePUSH; PUSHi((IV)RETVAL);
}
XSRETURN(1);
}
XS(XS_Perf__Trace__Context_common_lock_depth); /* prototype to pass -Wmissing-prototypes */
XS(XS_Perf__Trace__Context_common_lock_depth)
{
#ifdef dVAR
dVAR; dXSARGS;
#else
dXSARGS;
#endif
if (items != 1)
Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_lock_depth", "context");
PERL_UNUSED_VAR(cv); /* -W */
{
struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
int RETVAL;
dXSTARG;
RETVAL = common_lock_depth(context);
XSprePUSH; PUSHi((IV)RETVAL);
}
XSRETURN(1);
}
#ifdef __cplusplus
extern "C"
#endif
XS(boot_Perf__Trace__Context); /* prototype to pass -Wmissing-prototypes */
XS(boot_Perf__Trace__Context)
{
#ifdef dVAR
dVAR; dXSARGS;
#else
dXSARGS;
#endif
const char* file = __FILE__;
PERL_UNUSED_VAR(cv); /* -W */
PERL_UNUSED_VAR(items); /* -W */
XS_VERSION_BOOTCHECK ;
newXSproto("Perf::Trace::Context::common_pc", XS_Perf__Trace__Context_common_pc, file, "$");
newXSproto("Perf::Trace::Context::common_flags", XS_Perf__Trace__Context_common_flags, file, "$");
newXSproto("Perf::Trace::Context::common_lock_depth", XS_Perf__Trace__Context_common_lock_depth, file, "$");
if (PL_unitcheckav)
call_list(PL_scopestack_ix, PL_unitcheckav);
XSRETURN_YES;
}

View File

@@ -0,0 +1,42 @@
/*
* Context.xs. XS interfaces for perf script.
*
* Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
*
* 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; either version 2 of the License, or
* (at your option) any later version.
*
* 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.
*
* You should have received a copy of the GNU General Public License
* along with this program; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*
*/
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "../../../perf.h"
#include "../../../util/script-event.h"
MODULE = Perf::Trace::Context PACKAGE = Perf::Trace::Context
PROTOTYPES: ENABLE
int
common_pc(context)
struct scripting_context * context
int
common_flags(context)
struct scripting_context * context
int
common_lock_depth(context)
struct scripting_context * context

View File

@@ -0,0 +1,17 @@
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::Context',
VERSION_FROM => 'lib/Perf/Trace/Context.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/Context.pm', # retrieve abstract from module
AUTHOR => 'Tom Zanussi <tzanussi@gmail.com>') : ()),
LIBS => [''], # e.g., '-lm'
DEFINE => '-I ../..', # e.g., '-DHAVE_SOMETHING'
INC => '-I.', # e.g., '-I. -I/usr/include/other'
# Un-comment this if you add C files to link with later:
OBJECT => 'Context.o', # link all the C files too
);

View File

@@ -0,0 +1,59 @@
Perf-Trace-Util version 0.01
============================
This module contains utility functions for use with perf script.
Core.pm and Util.pm are pure Perl modules; Core.pm contains routines
that the core perf support for Perl calls on and should always be
'used', while Util.pm contains useful but optional utility functions
that scripts may want to use. Context.pm contains the Perl->C
interface that allows scripts to access data in the embedding perf
executable; scripts wishing to do that should 'use Context.pm'.
The Perl->C perf interface is completely driven by Context.xs. If you
want to add new Perl functions that end up accessing C data in the
perf executable, you add desciptions of the new functions here.
scripting_context is a pointer to the perf data in the perf executable
that you want to access - it's passed as the second parameter,
$context, to all handler functions.
After you do that:
perl Makefile.PL # to create a Makefile for the next step
make # to create Context.c
edit Context.c to add const to the char* file = __FILE__ line in
XS(boot_Perf__Trace__Context) to silence a warning/error.
You can delete the Makefile, object files and anything else that was
generated e.g. blib and shared library, etc, except for of course
Context.c
You should then be able to run the normal perf make as usual.
INSTALLATION
Building perf with perf script Perl scripting should install this
module in the right place.
You should make sure libperl and ExtUtils/Embed.pm are installed first
e.g. apt-get install libperl-dev or yum install perl-ExtUtils-Embed.
DEPENDENCIES
This module requires these other modules and libraries:
None
COPYRIGHT AND LICENCE
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.

View File

@@ -0,0 +1,55 @@
package Perf::Trace::Context;
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(
common_pc common_flags common_lock_depth
);
our $VERSION = '0.01';
require XSLoader;
XSLoader::load('Perf::Trace::Context', $VERSION);
1;
__END__
=head1 NAME
Perf::Trace::Context - Perl extension for accessing functions in perf.
=head1 SYNOPSIS
use Perf::Trace::Context;
=head1 SEE ALSO
Perf (script) 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

View File

@@ -0,0 +1,192 @@
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
trace_flag_str
);
our $VERSION = '0.01';
my %trace_flags = (0x00 => "NONE",
0x01 => "IRQS_OFF",
0x02 => "IRQS_NOSUPPORT",
0x04 => "NEED_RESCHED",
0x08 => "HARDIRQ",
0x10 => "SOFTIRQ");
sub trace_flag_str
{
my ($value) = @_;
my $string;
my $print_delim = 0;
foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
if (!$value && !$idx) {
$string .= "NONE";
last;
}
if ($idx && ($value & $idx) == $idx) {
if ($print_delim) {
$string .= " | ";
}
$string .= "$trace_flags{$idx}";
$print_delim = 1;
$value &= ~$idx;
}
}
return $string;
}
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 script
=head1 SYNOPSIS
use Perf::Trace::Core
=head1 SEE ALSO
Perf (script) 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

View File

@@ -0,0 +1,94 @@
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
clear_term
);
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_PER_SEC;
}
sub nsecs_str {
my ($nsecs) = @_;
my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));
return $str;
}
sub clear_term
{
print "\x1b[H\x1b[2J";
}
1;
__END__
=head1 NAME
Perf::Trace::Util - Perl extension for perf script
=head1 SYNOPSIS
use Perf::Trace::Util;
=head1 SEE ALSO
Perf (script) 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

View File

@@ -0,0 +1 @@
struct scripting_context * T_PTR

View File

@@ -0,0 +1,2 @@
#!/bin/bash
perf record -a -e kmem:kmalloc -e irq:softirq_entry -e kmem:kfree

View File

@@ -0,0 +1,2 @@
#!/bin/bash
perf record -e raw_syscalls:sys_exit $@

View File

@@ -0,0 +1,10 @@
#!/bin/bash
# description: system-wide failed syscalls
# args: [comm]
if [ $# -gt 0 ] ; then
if ! expr match "$1" "-" > /dev/null ; then
comm=$1
shift
fi
fi
perf script $@ -s "$PERF_EXEC_PATH"/scripts/perl/failed-syscalls.pl $comm

View File

@@ -0,0 +1,3 @@
#!/bin/bash
perf record -e syscalls:sys_enter_read -e syscalls:sys_enter_write $@

View File

@@ -0,0 +1,10 @@
#!/bin/bash
# description: r/w activity for a program, by file
# args: <comm>
if [ $# -lt 1 ] ; then
echo "usage: rw-by-file <comm>"
exit
fi
comm=$1
shift
perf script $@ -s "$PERF_EXEC_PATH"/scripts/perl/rw-by-file.pl $comm

View File

@@ -0,0 +1,2 @@
#!/bin/bash
perf record -e syscalls:sys_enter_read -e syscalls:sys_exit_read -e syscalls:sys_enter_write -e syscalls:sys_exit_write $@

View File

@@ -0,0 +1,3 @@
#!/bin/bash
# description: system-wide r/w activity
perf script $@ -s "$PERF_EXEC_PATH"/scripts/perl/rw-by-pid.pl

View File

@@ -0,0 +1,2 @@
#!/bin/bash
perf record -e syscalls:sys_enter_read -e syscalls:sys_exit_read -e syscalls:sys_enter_write -e syscalls:sys_exit_write $@

View File

@@ -0,0 +1,20 @@
#!/bin/bash
# description: system-wide r/w top
# args: [interval]
n_args=0
for i in "$@"
do
if expr match "$i" "-" > /dev/null ; then
break
fi
n_args=$(( $n_args + 1 ))
done
if [ "$n_args" -gt 1 ] ; then
echo "usage: rwtop-report [interval]"
exit
fi
if [ "$n_args" -gt 0 ] ; then
interval=$1
shift
fi
perf script $@ -s "$PERF_EXEC_PATH"/scripts/perl/rwtop.pl $interval

View File

@@ -0,0 +1,6 @@
#!/bin/bash
perf record -e sched:sched_switch -e sched:sched_wakeup $@

View File

@@ -0,0 +1,3 @@
#!/bin/bash
# description: system-wide min/max/avg wakeup latency
perf script $@ -s "$PERF_EXEC_PATH"/scripts/perl/wakeup-latency.pl

View File

@@ -0,0 +1,2 @@
#!/bin/bash
perf record -e workqueue:workqueue_creation -e workqueue:workqueue_destruction -e workqueue:workqueue_execution -e workqueue:workqueue_insertion $@

View File

@@ -0,0 +1,3 @@
#!/bin/bash
# description: workqueue stats (ins/exe/create/destroy)
perf script $@ -s "$PERF_EXEC_PATH"/scripts/perl/workqueue-stats.pl

View File

@@ -0,0 +1,106 @@
# perf script event handlers, generated by perf script -g perl
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
# This script tests basic functionality such as flag and symbol
# strings, common_xxx() calls back into perf, begin, end, unhandled
# events, etc. Basically, if this script runs successfully and
# displays expected results, perl scripting support should be ok.
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::Context;
use Perf::Trace::Util;
sub trace_begin
{
print "trace_begin\n";
}
sub trace_end
{
print "trace_end\n";
print_unhandled();
}
sub irq::softirq_entry
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$vec) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
print_uncommon($context);
printf("vec=%s\n",
symbol_str("irq::softirq_entry", "vec", $vec));
}
sub kmem::kmalloc
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$call_site, $ptr, $bytes_req, $bytes_alloc,
$gfp_flags) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
print_uncommon($context);
printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
"gfp_flags=%s\n",
$call_site, $ptr, $bytes_req, $bytes_alloc,
flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
}
# print trace fields not included in handler args
sub print_uncommon
{
my ($context) = @_;
printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
common_pc($context), trace_flag_str(common_flags($context)),
common_lock_depth($context));
}
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}++;
}
sub print_header
{
my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
printf("%-20s %5u %05u.%09u %8u %-20s ",
$event_name, $cpu, $secs, $nsecs, $pid, $comm);
}

View File

@@ -0,0 +1,42 @@
# failed system call counts
# (c) 2010, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
#
# Displays system-wide failed system call totals
# If a [comm] arg is specified, only syscalls called by [comm] are displayed.
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::Context;
use Perf::Trace::Util;
my $for_comm = shift;
my %failed_syscalls;
sub raw_syscalls::sys_exit
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$id, $ret) = @_;
if ($ret < 0) {
$failed_syscalls{$common_comm}++;
}
}
sub trace_end
{
printf("\nfailed syscalls by comm:\n\n");
printf("%-20s %10s\n", "comm", "# errors");
printf("%-20s %6s %10s\n", "--------------------", "----------");
foreach my $comm (sort {$failed_syscalls{$b} <=> $failed_syscalls{$a}}
keys %failed_syscalls) {
next if ($for_comm && $comm ne $for_comm);
printf("%-20s %10s\n", $comm, $failed_syscalls{$comm});
}
}

View File

@@ -0,0 +1,106 @@
#!/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;
my $usage = "perf script -s rw-by-file.pl <comm>\n";
my $for_comm = shift or die $usage;
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}++;
}

View File

@@ -0,0 +1,184 @@
#!/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} || 0) <=>
($reads{$a}{bytes_read} || 0) } keys %reads) {
my $comm = $reads{$pid}{comm} || "";
my $total_reads = $reads{$pid}{total_reads} || 0;
my $bytes_requested = $reads{$pid}{bytes_requested} || 0;
my $bytes_read = $reads{$pid}{bytes_read} || 0;
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", "------", "--------------------",
"------", "----------");
my @errcounts = ();
foreach my $pid (keys %reads) {
foreach my $error (keys %{$reads{$pid}{errors}}) {
my $comm = $reads{$pid}{comm} || "";
my $errcount = $reads{$pid}{errors}{$error} || 0;
push @errcounts, [$pid, $comm, $error, $errcount];
}
}
@errcounts = sort { $b->[3] <=> $a->[3] } @errcounts;
for my $i (0 .. $#errcounts) {
printf("%6d %-20s %6d %10s\n", $errcounts[$i][0],
$errcounts[$i][1], $errcounts[$i][2], $errcounts[$i][3]);
}
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} || 0) <=>
($writes{$a}{bytes_written} || 0)} keys %writes) {
my $comm = $writes{$pid}{comm} || "";
my $total_writes = $writes{$pid}{total_writes} || 0;
my $bytes_written = $writes{$pid}{bytes_written} || 0;
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", "------", "--------------------",
"------", "----------");
@errcounts = ();
foreach my $pid (keys %writes) {
foreach my $error (keys %{$writes{$pid}{errors}}) {
my $comm = $writes{$pid}{comm} || "";
my $errcount = $writes{$pid}{errors}{$error} || 0;
push @errcounts, [$pid, $comm, $error, $errcount];
}
}
@errcounts = sort { $b->[3] <=> $a->[3] } @errcounts;
for my $i (0 .. $#errcounts) {
printf("%6d %-20s %6d %10s\n", $errcounts[$i][0],
$errcounts[$i][1], $errcounts[$i][2], $errcounts[$i][3]);
}
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}++;
}

View File

@@ -0,0 +1,199 @@
#!/usr/bin/perl -w
# (c) 2010, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
# read/write top
#
# Periodically displays system-wide r/w call activity, broken down by
# pid. If an [interval] arg is specified, the display will be
# refreshed every [interval] seconds. The default interval is 3
# seconds.
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 $default_interval = 3;
my $nlines = 20;
my $print_thread;
my $print_pending = 0;
my %reads;
my %writes;
my $interval = shift;
if (!$interval) {
$interval = $default_interval;
}
sub syscalls::sys_exit_read
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$nr, $ret) = @_;
print_check();
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) = @_;
print_check();
$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) = @_;
print_check();
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) = @_;
print_check();
$writes{$common_pid}{bytes_written} += $count;
$writes{$common_pid}{total_writes}++;
$writes{$common_pid}{comm} = $common_comm;
}
sub trace_begin
{
$SIG{ALRM} = \&set_print_pending;
alarm 1;
}
sub trace_end
{
print_unhandled();
print_totals();
}
sub print_check()
{
if ($print_pending == 1) {
$print_pending = 0;
print_totals();
}
}
sub set_print_pending()
{
$print_pending = 1;
alarm $interval;
}
sub print_totals
{
my $count;
$count = 0;
clear_term();
printf("\nread counts by pid:\n\n");
printf("%6s %20s %10s %10s %10s\n", "pid", "comm",
"# reads", "bytes_req", "bytes_read");
printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------",
"----------", "----------", "----------");
foreach my $pid (sort { ($reads{$b}{bytes_read} || 0) <=>
($reads{$a}{bytes_read} || 0) } keys %reads) {
my $comm = $reads{$pid}{comm} || "";
my $total_reads = $reads{$pid}{total_reads} || 0;
my $bytes_requested = $reads{$pid}{bytes_requested} || 0;
my $bytes_read = $reads{$pid}{bytes_read} || 0;
printf("%6s %-20s %10s %10s %10s\n", $pid, $comm,
$total_reads, $bytes_requested, $bytes_read);
if (++$count == $nlines) {
last;
}
}
$count = 0;
printf("\nwrite counts by pid:\n\n");
printf("%6s %20s %10s %13s\n", "pid", "comm",
"# writes", "bytes_written");
printf("%6s %-20s %10s %13s\n", "------", "--------------------",
"----------", "-------------");
foreach my $pid (sort { ($writes{$b}{bytes_written} || 0) <=>
($writes{$a}{bytes_written} || 0)} keys %writes) {
my $comm = $writes{$pid}{comm} || "";
my $total_writes = $writes{$pid}{total_writes} || 0;
my $bytes_written = $writes{$pid}{bytes_written} || 0;
printf("%6s %-20s %10s %13s\n", $pid, $comm,
$total_writes, $bytes_written);
if (++$count == $nlines) {
last;
}
}
%reads = ();
%writes = ();
}
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}++;
}

View File

@@ -0,0 +1,107 @@
#!/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";
use Perf::Trace::Core;
use Perf::Trace::Util;
my %last_wakeup;
my $max_wakeup_latency;
my $min_wakeup_latency;
my $total_wakeup_latency = 0;
my $total_wakeups = 0;
sub sched::sched_switch
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid,
$next_prio) = @_;
my $wakeup_ts = $last_wakeup{$common_cpu}{ts};
if ($wakeup_ts) {
my $switch_ts = nsecs($common_secs, $common_nsecs);
my $wakeup_latency = $switch_ts - $wakeup_ts;
if ($wakeup_latency > $max_wakeup_latency) {
$max_wakeup_latency = $wakeup_latency;
}
if ($wakeup_latency < $min_wakeup_latency) {
$min_wakeup_latency = $wakeup_latency;
}
$total_wakeup_latency += $wakeup_latency;
$total_wakeups++;
}
$last_wakeup{$common_cpu}{ts} = 0;
}
sub sched::sched_wakeup
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$comm, $pid, $prio, $success, $target_cpu) = @_;
$last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs);
}
sub trace_begin
{
$min_wakeup_latency = 1000000000;
$max_wakeup_latency = 0;
}
sub trace_end
{
printf("wakeup_latency stats:\n\n");
print "total_wakeups: $total_wakeups\n";
if ($total_wakeups) {
printf("avg_wakeup_latency (ns): %u\n",
avg($total_wakeup_latency, $total_wakeups));
} else {
printf("avg_wakeup_latency (ns): N/A\n");
}
printf("min_wakeup_latency (ns): %u\n", $min_wakeup_latency);
printf("max_wakeup_latency (ns): %u\n", $max_wakeup_latency);
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}++;
}

View File

@@ -0,0 +1,129 @@
#!/usr/bin/perl -w
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
# Licensed under the terms of the GNU GPL License version 2
# Displays workqueue stats
#
# Usage:
#
# perf record -c 1 -f -a -R -e workqueue:workqueue_creation -e
# workqueue:workqueue_destruction -e workqueue:workqueue_execution
# -e workqueue:workqueue_insertion
#
# perf script -p -s tools/perf/scripts/perl/workqueue-stats.pl
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 @cpus;
sub workqueue::workqueue_destruction
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$thread_comm, $thread_pid) = @_;
$cpus[$common_cpu]{$thread_pid}{destroyed}++;
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
}
sub workqueue::workqueue_creation
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$thread_comm, $thread_pid, $cpu) = @_;
$cpus[$common_cpu]{$thread_pid}{created}++;
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
}
sub workqueue::workqueue_execution
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$thread_comm, $thread_pid, $func) = @_;
$cpus[$common_cpu]{$thread_pid}{executed}++;
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
}
sub workqueue::workqueue_insertion
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$thread_comm, $thread_pid, $func) = @_;
$cpus[$common_cpu]{$thread_pid}{inserted}++;
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
}
sub trace_end
{
print "workqueue work stats:\n\n";
my $cpu = 0;
printf("%3s %6s %6s\t%-20s\n", "cpu", "ins", "exec", "name");
printf("%3s %6s %6s\t%-20s\n", "---", "---", "----", "----");
foreach my $pidhash (@cpus) {
while ((my $pid, my $wqhash) = each %$pidhash) {
my $ins = $$wqhash{'inserted'} || 0;
my $exe = $$wqhash{'executed'} || 0;
my $comm = $$wqhash{'comm'} || "";
if ($ins || $exe) {
printf("%3u %6u %6u\t%-20s\n", $cpu, $ins, $exe, $comm);
}
}
$cpu++;
}
$cpu = 0;
print "\nworkqueue lifecycle stats:\n\n";
printf("%3s %6s %6s\t%-20s\n", "cpu", "created", "destroyed", "name");
printf("%3s %6s %6s\t%-20s\n", "---", "-------", "---------", "----");
foreach my $pidhash (@cpus) {
while ((my $pid, my $wqhash) = each %$pidhash) {
my $created = $$wqhash{'created'} || 0;
my $destroyed = $$wqhash{'destroyed'} || 0;
my $comm = $$wqhash{'comm'} || "";
if ($created || $destroyed) {
printf("%3u %6u %6u\t%-20s\n", $cpu, $created, $destroyed,
$comm);
}
}
$cpu++;
}
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}++;
}