diff options
| author | Benjamin Herrenschmidt <benh@kernel.crashing.org> | 2009-12-09 01:14:38 -0500 |
|---|---|---|
| committer | Benjamin Herrenschmidt <benh@kernel.crashing.org> | 2009-12-09 01:14:38 -0500 |
| commit | bcd6acd51f3d4d1ada201e9bc5c40a31d6d80c71 (patch) | |
| tree | 2f6dffd2d3e4dd67355a224de7e7a960335a92fd /tools/perf/scripts | |
| parent | 11c34c7deaeeebcee342cbc35e1bb2a6711b2431 (diff) | |
| parent | 3ff6a468b45b5dfeb0e903e56f4eb27d34b2437c (diff) | |
Merge commit 'origin/master' into next
Conflicts:
include/linux/kvm.h
Diffstat (limited to 'tools/perf/scripts')
23 files changed, 1245 insertions, 0 deletions
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Context.c b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c new file mode 100644 index 000000000000..af78d9a52a7d --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c | |||
| @@ -0,0 +1,134 @@ | |||
| 1 | /* | ||
| 2 | * This file was generated automatically by ExtUtils::ParseXS version 2.18_02 from the | ||
| 3 | * contents of Context.xs. Do not edit this file, edit Context.xs instead. | ||
| 4 | * | ||
| 5 | * ANY CHANGES MADE HERE WILL BE LOST! | ||
| 6 | * | ||
| 7 | */ | ||
| 8 | |||
| 9 | #line 1 "Context.xs" | ||
| 10 | /* | ||
| 11 | * Context.xs. XS interfaces for perf trace. | ||
| 12 | * | ||
| 13 | * Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com> | ||
| 14 | * | ||
| 15 | * This program is free software; you can redistribute it and/or modify | ||
| 16 | * it under the terms of the GNU General Public License as published by | ||
| 17 | * the Free Software Foundation; either version 2 of the License, or | ||
| 18 | * (at your option) any later version. | ||
| 19 | * | ||
| 20 | * This program is distributed in the hope that it will be useful, | ||
| 21 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 22 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 23 | * GNU General Public License for more details. | ||
| 24 | * | ||
| 25 | * You should have received a copy of the GNU General Public License | ||
| 26 | * along with this program; if not, write to the Free Software | ||
| 27 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
| 28 | * | ||
| 29 | */ | ||
| 30 | |||
| 31 | #include "EXTERN.h" | ||
| 32 | #include "perl.h" | ||
| 33 | #include "XSUB.h" | ||
| 34 | #include "../../../util/trace-event-perl.h" | ||
| 35 | |||
| 36 | #ifndef PERL_UNUSED_VAR | ||
| 37 | # define PERL_UNUSED_VAR(var) if (0) var = var | ||
| 38 | #endif | ||
| 39 | |||
| 40 | #line 41 "Context.c" | ||
| 41 | |||
| 42 | XS(XS_Perf__Trace__Context_common_pc); /* prototype to pass -Wmissing-prototypes */ | ||
| 43 | XS(XS_Perf__Trace__Context_common_pc) | ||
| 44 | { | ||
| 45 | #ifdef dVAR | ||
| 46 | dVAR; dXSARGS; | ||
| 47 | #else | ||
| 48 | dXSARGS; | ||
| 49 | #endif | ||
| 50 | if (items != 1) | ||
| 51 | Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_pc", "context"); | ||
| 52 | PERL_UNUSED_VAR(cv); /* -W */ | ||
| 53 | { | ||
| 54 | struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0))); | ||
| 55 | int RETVAL; | ||
| 56 | dXSTARG; | ||
| 57 | |||
| 58 | RETVAL = common_pc(context); | ||
| 59 | XSprePUSH; PUSHi((IV)RETVAL); | ||
| 60 | } | ||
| 61 | XSRETURN(1); | ||
| 62 | } | ||
| 63 | |||
| 64 | |||
| 65 | XS(XS_Perf__Trace__Context_common_flags); /* prototype to pass -Wmissing-prototypes */ | ||
| 66 | XS(XS_Perf__Trace__Context_common_flags) | ||
| 67 | { | ||
| 68 | #ifdef dVAR | ||
| 69 | dVAR; dXSARGS; | ||
| 70 | #else | ||
| 71 | dXSARGS; | ||
| 72 | #endif | ||
| 73 | if (items != 1) | ||
| 74 | Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_flags", "context"); | ||
| 75 | PERL_UNUSED_VAR(cv); /* -W */ | ||
| 76 | { | ||
| 77 | struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0))); | ||
| 78 | int RETVAL; | ||
| 79 | dXSTARG; | ||
| 80 | |||
| 81 | RETVAL = common_flags(context); | ||
| 82 | XSprePUSH; PUSHi((IV)RETVAL); | ||
| 83 | } | ||
| 84 | XSRETURN(1); | ||
| 85 | } | ||
| 86 | |||
| 87 | |||
| 88 | XS(XS_Perf__Trace__Context_common_lock_depth); /* prototype to pass -Wmissing-prototypes */ | ||
| 89 | XS(XS_Perf__Trace__Context_common_lock_depth) | ||
| 90 | { | ||
| 91 | #ifdef dVAR | ||
| 92 | dVAR; dXSARGS; | ||
| 93 | #else | ||
| 94 | dXSARGS; | ||
| 95 | #endif | ||
| 96 | if (items != 1) | ||
| 97 | Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_lock_depth", "context"); | ||
| 98 | PERL_UNUSED_VAR(cv); /* -W */ | ||
| 99 | { | ||
| 100 | struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0))); | ||
| 101 | int RETVAL; | ||
| 102 | dXSTARG; | ||
| 103 | |||
| 104 | RETVAL = common_lock_depth(context); | ||
| 105 | XSprePUSH; PUSHi((IV)RETVAL); | ||
| 106 | } | ||
| 107 | XSRETURN(1); | ||
| 108 | } | ||
| 109 | |||
| 110 | #ifdef __cplusplus | ||
| 111 | extern "C" | ||
| 112 | #endif | ||
| 113 | XS(boot_Perf__Trace__Context); /* prototype to pass -Wmissing-prototypes */ | ||
| 114 | XS(boot_Perf__Trace__Context) | ||
| 115 | { | ||
| 116 | #ifdef dVAR | ||
| 117 | dVAR; dXSARGS; | ||
| 118 | #else | ||
| 119 | dXSARGS; | ||
| 120 | #endif | ||
| 121 | const char* file = __FILE__; | ||
| 122 | |||
| 123 | PERL_UNUSED_VAR(cv); /* -W */ | ||
| 124 | PERL_UNUSED_VAR(items); /* -W */ | ||
| 125 | XS_VERSION_BOOTCHECK ; | ||
| 126 | |||
| 127 | newXSproto("Perf::Trace::Context::common_pc", XS_Perf__Trace__Context_common_pc, file, "$"); | ||
| 128 | newXSproto("Perf::Trace::Context::common_flags", XS_Perf__Trace__Context_common_flags, file, "$"); | ||
| 129 | newXSproto("Perf::Trace::Context::common_lock_depth", XS_Perf__Trace__Context_common_lock_depth, file, "$"); | ||
| 130 | if (PL_unitcheckav) | ||
| 131 | call_list(PL_scopestack_ix, PL_unitcheckav); | ||
| 132 | XSRETURN_YES; | ||
| 133 | } | ||
| 134 | |||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs new file mode 100644 index 000000000000..fb78006c165e --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs | |||
| @@ -0,0 +1,41 @@ | |||
| 1 | /* | ||
| 2 | * Context.xs. XS interfaces for perf trace. | ||
| 3 | * | ||
| 4 | * Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com> | ||
| 5 | * | ||
| 6 | * This program is free software; you can redistribute it and/or modify | ||
| 7 | * it under the terms of the GNU General Public License as published by | ||
| 8 | * the Free Software Foundation; either version 2 of the License, or | ||
| 9 | * (at your option) any later version. | ||
| 10 | * | ||
| 11 | * This program is distributed in the hope that it will be useful, | ||
| 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
| 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
| 14 | * GNU General Public License for more details. | ||
| 15 | * | ||
| 16 | * You should have received a copy of the GNU General Public License | ||
| 17 | * along with this program; if not, write to the Free Software | ||
| 18 | * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA | ||
| 19 | * | ||
| 20 | */ | ||
| 21 | |||
| 22 | #include "EXTERN.h" | ||
| 23 | #include "perl.h" | ||
| 24 | #include "XSUB.h" | ||
| 25 | #include "../../../util/trace-event-perl.h" | ||
| 26 | |||
| 27 | MODULE = Perf::Trace::Context PACKAGE = Perf::Trace::Context | ||
| 28 | PROTOTYPES: ENABLE | ||
| 29 | |||
| 30 | int | ||
| 31 | common_pc(context) | ||
| 32 | struct scripting_context * context | ||
| 33 | |||
| 34 | int | ||
| 35 | common_flags(context) | ||
| 36 | struct scripting_context * context | ||
| 37 | |||
| 38 | int | ||
| 39 | common_lock_depth(context) | ||
| 40 | struct scripting_context * context | ||
| 41 | |||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL new file mode 100644 index 000000000000..decdeb0f6789 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL | |||
| @@ -0,0 +1,17 @@ | |||
| 1 | use 5.010000; | ||
| 2 | use ExtUtils::MakeMaker; | ||
| 3 | # See lib/ExtUtils/MakeMaker.pm for details of how to influence | ||
| 4 | # the contents of the Makefile that is written. | ||
| 5 | WriteMakefile( | ||
| 6 | NAME => 'Perf::Trace::Context', | ||
| 7 | VERSION_FROM => 'lib/Perf/Trace/Context.pm', # finds $VERSION | ||
| 8 | PREREQ_PM => {}, # e.g., Module::Name => 1.1 | ||
| 9 | ($] >= 5.005 ? ## Add these new keywords supported since 5.005 | ||
| 10 | (ABSTRACT_FROM => 'lib/Perf/Trace/Context.pm', # retrieve abstract from module | ||
| 11 | AUTHOR => 'Tom Zanussi <tzanussi@gmail.com>') : ()), | ||
| 12 | LIBS => [''], # e.g., '-lm' | ||
| 13 | DEFINE => '-I ../..', # e.g., '-DHAVE_SOMETHING' | ||
| 14 | INC => '-I.', # e.g., '-I. -I/usr/include/other' | ||
| 15 | # Un-comment this if you add C files to link with later: | ||
| 16 | OBJECT => 'Context.o', # link all the C files too | ||
| 17 | ); | ||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/README b/tools/perf/scripts/perl/Perf-Trace-Util/README new file mode 100644 index 000000000000..9a9707630791 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/README | |||
| @@ -0,0 +1,59 @@ | |||
| 1 | Perf-Trace-Util version 0.01 | ||
| 2 | ============================ | ||
| 3 | |||
| 4 | This module contains utility functions for use with perf trace. | ||
| 5 | |||
| 6 | Core.pm and Util.pm are pure Perl modules; Core.pm contains routines | ||
| 7 | that the core perf support for Perl calls on and should always be | ||
| 8 | 'used', while Util.pm contains useful but optional utility functions | ||
| 9 | that scripts may want to use. Context.pm contains the Perl->C | ||
| 10 | interface that allows scripts to access data in the embedding perf | ||
| 11 | executable; scripts wishing to do that should 'use Context.pm'. | ||
| 12 | |||
| 13 | The Perl->C perf interface is completely driven by Context.xs. If you | ||
| 14 | want to add new Perl functions that end up accessing C data in the | ||
| 15 | perf executable, you add desciptions of the new functions here. | ||
| 16 | scripting_context is a pointer to the perf data in the perf executable | ||
| 17 | that you want to access - it's passed as the second parameter, | ||
| 18 | $context, to all handler functions. | ||
| 19 | |||
| 20 | After you do that: | ||
| 21 | |||
| 22 | perl Makefile.PL # to create a Makefile for the next step | ||
| 23 | make # to create Context.c | ||
| 24 | |||
| 25 | edit Context.c to add const to the char* file = __FILE__ line in | ||
| 26 | XS(boot_Perf__Trace__Context) to silence a warning/error. | ||
| 27 | |||
| 28 | You can delete the Makefile, object files and anything else that was | ||
| 29 | generated e.g. blib and shared library, etc, except for of course | ||
| 30 | Context.c | ||
| 31 | |||
| 32 | You should then be able to run the normal perf make as usual. | ||
| 33 | |||
| 34 | INSTALLATION | ||
| 35 | |||
| 36 | Building perf with perf trace Perl scripting should install this | ||
| 37 | module in the right place. | ||
| 38 | |||
| 39 | You should make sure libperl and ExtUtils/Embed.pm are installed first | ||
| 40 | e.g. apt-get install libperl-dev or yum install perl-ExtUtils-Embed. | ||
| 41 | |||
| 42 | DEPENDENCIES | ||
| 43 | |||
| 44 | This module requires these other modules and libraries: | ||
| 45 | |||
| 46 | None | ||
| 47 | |||
| 48 | COPYRIGHT AND LICENCE | ||
| 49 | |||
| 50 | Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com> | ||
| 51 | |||
| 52 | This library is free software; you can redistribute it and/or modify | ||
| 53 | it under the same terms as Perl itself, either Perl version 5.10.0 or, | ||
| 54 | at your option, any later version of Perl 5 you may have available. | ||
| 55 | |||
| 56 | Alternatively, this software may be distributed under the terms of the | ||
| 57 | GNU General Public License ("GPL") version 2 as published by the Free | ||
| 58 | Software Foundation. | ||
| 59 | |||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm new file mode 100644 index 000000000000..6c7f3659cb17 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm | |||
| @@ -0,0 +1,55 @@ | |||
| 1 | package Perf::Trace::Context; | ||
| 2 | |||
| 3 | use 5.010000; | ||
| 4 | use strict; | ||
| 5 | use warnings; | ||
| 6 | |||
| 7 | require Exporter; | ||
| 8 | |||
| 9 | our @ISA = qw(Exporter); | ||
| 10 | |||
| 11 | our %EXPORT_TAGS = ( 'all' => [ qw( | ||
| 12 | ) ] ); | ||
| 13 | |||
| 14 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||
| 15 | |||
| 16 | our @EXPORT = qw( | ||
| 17 | common_pc common_flags common_lock_depth | ||
| 18 | ); | ||
| 19 | |||
| 20 | our $VERSION = '0.01'; | ||
| 21 | |||
| 22 | require XSLoader; | ||
| 23 | XSLoader::load('Perf::Trace::Context', $VERSION); | ||
| 24 | |||
| 25 | 1; | ||
| 26 | __END__ | ||
| 27 | =head1 NAME | ||
| 28 | |||
| 29 | Perf::Trace::Context - Perl extension for accessing functions in perf. | ||
| 30 | |||
| 31 | =head1 SYNOPSIS | ||
| 32 | |||
| 33 | use Perf::Trace::Context; | ||
| 34 | |||
| 35 | =head1 SEE ALSO | ||
| 36 | |||
| 37 | Perf (trace) documentation | ||
| 38 | |||
| 39 | =head1 AUTHOR | ||
| 40 | |||
| 41 | Tom Zanussi, E<lt>tzanussi@gmail.com<gt> | ||
| 42 | |||
| 43 | =head1 COPYRIGHT AND LICENSE | ||
| 44 | |||
| 45 | Copyright (C) 2009 by Tom Zanussi | ||
| 46 | |||
| 47 | This library is free software; you can redistribute it and/or modify | ||
| 48 | it under the same terms as Perl itself, either Perl version 5.10.0 or, | ||
| 49 | at your option, any later version of Perl 5 you may have available. | ||
| 50 | |||
| 51 | Alternatively, this software may be distributed under the terms of the | ||
| 52 | GNU General Public License ("GPL") version 2 as published by the Free | ||
| 53 | Software Foundation. | ||
| 54 | |||
| 55 | =cut | ||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm new file mode 100644 index 000000000000..9df376a9f629 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | |||
| @@ -0,0 +1,192 @@ | |||
| 1 | package Perf::Trace::Core; | ||
| 2 | |||
| 3 | use 5.010000; | ||
| 4 | use strict; | ||
| 5 | use warnings; | ||
| 6 | |||
| 7 | require Exporter; | ||
| 8 | |||
| 9 | our @ISA = qw(Exporter); | ||
| 10 | |||
| 11 | our %EXPORT_TAGS = ( 'all' => [ qw( | ||
| 12 | ) ] ); | ||
| 13 | |||
| 14 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||
| 15 | |||
| 16 | our @EXPORT = qw( | ||
| 17 | define_flag_field define_flag_value flag_str dump_flag_fields | ||
| 18 | define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields | ||
| 19 | trace_flag_str | ||
| 20 | ); | ||
| 21 | |||
| 22 | our $VERSION = '0.01'; | ||
| 23 | |||
| 24 | my %trace_flags = (0x00 => "NONE", | ||
| 25 | 0x01 => "IRQS_OFF", | ||
| 26 | 0x02 => "IRQS_NOSUPPORT", | ||
| 27 | 0x04 => "NEED_RESCHED", | ||
| 28 | 0x08 => "HARDIRQ", | ||
| 29 | 0x10 => "SOFTIRQ"); | ||
| 30 | |||
| 31 | sub trace_flag_str | ||
| 32 | { | ||
| 33 | my ($value) = @_; | ||
| 34 | |||
| 35 | my $string; | ||
| 36 | |||
| 37 | my $print_delim = 0; | ||
| 38 | |||
| 39 | foreach my $idx (sort {$a <=> $b} keys %trace_flags) { | ||
| 40 | if (!$value && !$idx) { | ||
| 41 | $string .= "NONE"; | ||
| 42 | last; | ||
| 43 | } | ||
| 44 | |||
| 45 | if ($idx && ($value & $idx) == $idx) { | ||
| 46 | if ($print_delim) { | ||
| 47 | $string .= " | "; | ||
| 48 | } | ||
| 49 | $string .= "$trace_flags{$idx}"; | ||
| 50 | $print_delim = 1; | ||
| 51 | $value &= ~$idx; | ||
| 52 | } | ||
| 53 | } | ||
| 54 | |||
| 55 | return $string; | ||
| 56 | } | ||
| 57 | |||
| 58 | my %flag_fields; | ||
| 59 | my %symbolic_fields; | ||
| 60 | |||
| 61 | sub flag_str | ||
| 62 | { | ||
| 63 | my ($event_name, $field_name, $value) = @_; | ||
| 64 | |||
| 65 | my $string; | ||
| 66 | |||
| 67 | if ($flag_fields{$event_name}{$field_name}) { | ||
| 68 | my $print_delim = 0; | ||
| 69 | foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) { | ||
| 70 | if (!$value && !$idx) { | ||
| 71 | $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
| 72 | last; | ||
| 73 | } | ||
| 74 | if ($idx && ($value & $idx) == $idx) { | ||
| 75 | if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) { | ||
| 76 | $string .= " $flag_fields{$event_name}{$field_name}{'delim'} "; | ||
| 77 | } | ||
| 78 | $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
| 79 | $print_delim = 1; | ||
| 80 | $value &= ~$idx; | ||
| 81 | } | ||
| 82 | } | ||
| 83 | } | ||
| 84 | |||
| 85 | return $string; | ||
| 86 | } | ||
| 87 | |||
| 88 | sub define_flag_field | ||
| 89 | { | ||
| 90 | my ($event_name, $field_name, $delim) = @_; | ||
| 91 | |||
| 92 | $flag_fields{$event_name}{$field_name}{"delim"} = $delim; | ||
| 93 | } | ||
| 94 | |||
| 95 | sub define_flag_value | ||
| 96 | { | ||
| 97 | my ($event_name, $field_name, $value, $field_str) = @_; | ||
| 98 | |||
| 99 | $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str; | ||
| 100 | } | ||
| 101 | |||
| 102 | sub dump_flag_fields | ||
| 103 | { | ||
| 104 | for my $event (keys %flag_fields) { | ||
| 105 | print "event $event:\n"; | ||
| 106 | for my $field (keys %{$flag_fields{$event}}) { | ||
| 107 | print " field: $field:\n"; | ||
| 108 | print " delim: $flag_fields{$event}{$field}{'delim'}\n"; | ||
| 109 | foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) { | ||
| 110 | print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n"; | ||
| 111 | } | ||
| 112 | } | ||
| 113 | } | ||
| 114 | } | ||
| 115 | |||
| 116 | sub symbol_str | ||
| 117 | { | ||
| 118 | my ($event_name, $field_name, $value) = @_; | ||
| 119 | |||
| 120 | if ($symbolic_fields{$event_name}{$field_name}) { | ||
| 121 | foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) { | ||
| 122 | if (!$value && !$idx) { | ||
| 123 | return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
| 124 | last; | ||
| 125 | } | ||
| 126 | if ($value == $idx) { | ||
| 127 | return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
| 128 | } | ||
| 129 | } | ||
| 130 | } | ||
| 131 | |||
| 132 | return undef; | ||
| 133 | } | ||
| 134 | |||
| 135 | sub define_symbolic_field | ||
| 136 | { | ||
| 137 | my ($event_name, $field_name) = @_; | ||
| 138 | |||
| 139 | # nothing to do, really | ||
| 140 | } | ||
| 141 | |||
| 142 | sub define_symbolic_value | ||
| 143 | { | ||
| 144 | my ($event_name, $field_name, $value, $field_str) = @_; | ||
| 145 | |||
| 146 | $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str; | ||
| 147 | } | ||
| 148 | |||
| 149 | sub dump_symbolic_fields | ||
| 150 | { | ||
| 151 | for my $event (keys %symbolic_fields) { | ||
| 152 | print "event $event:\n"; | ||
| 153 | for my $field (keys %{$symbolic_fields{$event}}) { | ||
| 154 | print " field: $field:\n"; | ||
| 155 | foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) { | ||
| 156 | print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n"; | ||
| 157 | } | ||
| 158 | } | ||
| 159 | } | ||
| 160 | } | ||
| 161 | |||
| 162 | 1; | ||
| 163 | __END__ | ||
| 164 | =head1 NAME | ||
| 165 | |||
| 166 | Perf::Trace::Core - Perl extension for perf trace | ||
| 167 | |||
| 168 | =head1 SYNOPSIS | ||
| 169 | |||
| 170 | use Perf::Trace::Core | ||
| 171 | |||
| 172 | =head1 SEE ALSO | ||
| 173 | |||
| 174 | Perf (trace) documentation | ||
| 175 | |||
| 176 | =head1 AUTHOR | ||
| 177 | |||
| 178 | Tom Zanussi, E<lt>tzanussi@gmail.com<gt> | ||
| 179 | |||
| 180 | =head1 COPYRIGHT AND LICENSE | ||
| 181 | |||
| 182 | Copyright (C) 2009 by Tom Zanussi | ||
| 183 | |||
| 184 | This library is free software; you can redistribute it and/or modify | ||
| 185 | it under the same terms as Perl itself, either Perl version 5.10.0 or, | ||
| 186 | at your option, any later version of Perl 5 you may have available. | ||
| 187 | |||
| 188 | Alternatively, this software may be distributed under the terms of the | ||
| 189 | GNU General Public License ("GPL") version 2 as published by the Free | ||
| 190 | Software Foundation. | ||
| 191 | |||
| 192 | =cut | ||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm new file mode 100644 index 000000000000..052f132ced24 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm | |||
| @@ -0,0 +1,88 @@ | |||
| 1 | package Perf::Trace::Util; | ||
| 2 | |||
| 3 | use 5.010000; | ||
| 4 | use strict; | ||
| 5 | use warnings; | ||
| 6 | |||
| 7 | require Exporter; | ||
| 8 | |||
| 9 | our @ISA = qw(Exporter); | ||
| 10 | |||
| 11 | our %EXPORT_TAGS = ( 'all' => [ qw( | ||
| 12 | ) ] ); | ||
| 13 | |||
| 14 | our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); | ||
| 15 | |||
| 16 | our @EXPORT = qw( | ||
| 17 | avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs | ||
| 18 | ); | ||
| 19 | |||
| 20 | our $VERSION = '0.01'; | ||
| 21 | |||
| 22 | sub avg | ||
| 23 | { | ||
| 24 | my ($total, $n) = @_; | ||
| 25 | |||
| 26 | return $total / $n; | ||
| 27 | } | ||
| 28 | |||
| 29 | my $NSECS_PER_SEC = 1000000000; | ||
| 30 | |||
| 31 | sub nsecs | ||
| 32 | { | ||
| 33 | my ($secs, $nsecs) = @_; | ||
| 34 | |||
| 35 | return $secs * $NSECS_PER_SEC + $nsecs; | ||
| 36 | } | ||
| 37 | |||
| 38 | sub nsecs_secs { | ||
| 39 | my ($nsecs) = @_; | ||
| 40 | |||
| 41 | return $nsecs / $NSECS_PER_SEC; | ||
| 42 | } | ||
| 43 | |||
| 44 | sub nsecs_nsecs { | ||
| 45 | my ($nsecs) = @_; | ||
| 46 | |||
| 47 | return $nsecs - nsecs_secs($nsecs); | ||
| 48 | } | ||
| 49 | |||
| 50 | sub nsecs_str { | ||
| 51 | my ($nsecs) = @_; | ||
| 52 | |||
| 53 | my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs)); | ||
| 54 | |||
| 55 | return $str; | ||
| 56 | } | ||
| 57 | |||
| 58 | 1; | ||
| 59 | __END__ | ||
| 60 | =head1 NAME | ||
| 61 | |||
| 62 | Perf::Trace::Util - Perl extension for perf trace | ||
| 63 | |||
| 64 | =head1 SYNOPSIS | ||
| 65 | |||
| 66 | use Perf::Trace::Util; | ||
| 67 | |||
| 68 | =head1 SEE ALSO | ||
| 69 | |||
| 70 | Perf (trace) documentation | ||
| 71 | |||
| 72 | =head1 AUTHOR | ||
| 73 | |||
| 74 | Tom Zanussi, E<lt>tzanussi@gmail.com<gt> | ||
| 75 | |||
| 76 | =head1 COPYRIGHT AND LICENSE | ||
| 77 | |||
| 78 | Copyright (C) 2009 by Tom Zanussi | ||
| 79 | |||
| 80 | This library is free software; you can redistribute it and/or modify | ||
| 81 | it under the same terms as Perl itself, either Perl version 5.10.0 or, | ||
| 82 | at your option, any later version of Perl 5 you may have available. | ||
| 83 | |||
| 84 | Alternatively, this software may be distributed under the terms of the | ||
| 85 | GNU General Public License ("GPL") version 2 as published by the Free | ||
| 86 | Software Foundation. | ||
| 87 | |||
| 88 | =cut | ||
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/typemap b/tools/perf/scripts/perl/Perf-Trace-Util/typemap new file mode 100644 index 000000000000..840836804aa7 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/typemap | |||
| @@ -0,0 +1 @@ | |||
| struct scripting_context * T_PTR | |||
diff --git a/tools/perf/scripts/perl/bin/check-perf-trace-record b/tools/perf/scripts/perl/bin/check-perf-trace-record new file mode 100644 index 000000000000..c7ec5de2f535 --- /dev/null +++ b/tools/perf/scripts/perl/bin/check-perf-trace-record | |||
| @@ -0,0 +1,7 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf record -c 1 -f -a -M -R -e kmem:kmalloc -e irq:softirq_entry | ||
| 3 | |||
| 4 | |||
| 5 | |||
| 6 | |||
| 7 | |||
diff --git a/tools/perf/scripts/perl/bin/check-perf-trace-report b/tools/perf/scripts/perl/bin/check-perf-trace-report new file mode 100644 index 000000000000..89948b015020 --- /dev/null +++ b/tools/perf/scripts/perl/bin/check-perf-trace-report | |||
| @@ -0,0 +1,5 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf trace -s ~/libexec/perf-core/scripts/perl/check-perf-trace.pl | ||
| 3 | |||
| 4 | |||
| 5 | |||
diff --git a/tools/perf/scripts/perl/bin/rw-by-file-record b/tools/perf/scripts/perl/bin/rw-by-file-record new file mode 100644 index 000000000000..b25056ebf963 --- /dev/null +++ b/tools/perf/scripts/perl/bin/rw-by-file-record | |||
| @@ -0,0 +1,2 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_enter_write | ||
diff --git a/tools/perf/scripts/perl/bin/rw-by-file-report b/tools/perf/scripts/perl/bin/rw-by-file-report new file mode 100644 index 000000000000..f5dcf9cb5bd2 --- /dev/null +++ b/tools/perf/scripts/perl/bin/rw-by-file-report | |||
| @@ -0,0 +1,5 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl | ||
| 3 | |||
| 4 | |||
| 5 | |||
diff --git a/tools/perf/scripts/perl/bin/rw-by-pid-record b/tools/perf/scripts/perl/bin/rw-by-pid-record new file mode 100644 index 000000000000..8903979c5b6c --- /dev/null +++ b/tools/perf/scripts/perl/bin/rw-by-pid-record | |||
| @@ -0,0 +1,2 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_exit_read -e syscalls:sys_enter_write -e syscalls:sys_exit_write | ||
diff --git a/tools/perf/scripts/perl/bin/rw-by-pid-report b/tools/perf/scripts/perl/bin/rw-by-pid-report new file mode 100644 index 000000000000..cea16f78a3a2 --- /dev/null +++ b/tools/perf/scripts/perl/bin/rw-by-pid-report | |||
| @@ -0,0 +1,5 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl | ||
| 3 | |||
| 4 | |||
| 5 | |||
diff --git a/tools/perf/scripts/perl/bin/wakeup-latency-record b/tools/perf/scripts/perl/bin/wakeup-latency-record new file mode 100644 index 000000000000..6abedda911a4 --- /dev/null +++ b/tools/perf/scripts/perl/bin/wakeup-latency-record | |||
| @@ -0,0 +1,6 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup | ||
| 3 | |||
| 4 | |||
| 5 | |||
| 6 | |||
diff --git a/tools/perf/scripts/perl/bin/wakeup-latency-report b/tools/perf/scripts/perl/bin/wakeup-latency-report new file mode 100644 index 000000000000..85769dc456eb --- /dev/null +++ b/tools/perf/scripts/perl/bin/wakeup-latency-report | |||
| @@ -0,0 +1,5 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl | ||
| 3 | |||
| 4 | |||
| 5 | |||
diff --git a/tools/perf/scripts/perl/bin/workqueue-stats-record b/tools/perf/scripts/perl/bin/workqueue-stats-record new file mode 100644 index 000000000000..fce6637b19ba --- /dev/null +++ b/tools/perf/scripts/perl/bin/workqueue-stats-record | |||
| @@ -0,0 +1,2 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf record -c 1 -f -a -M -R -e workqueue:workqueue_creation -e workqueue:workqueue_destruction -e workqueue:workqueue_execution -e workqueue:workqueue_insertion | ||
diff --git a/tools/perf/scripts/perl/bin/workqueue-stats-report b/tools/perf/scripts/perl/bin/workqueue-stats-report new file mode 100644 index 000000000000..aa68435be926 --- /dev/null +++ b/tools/perf/scripts/perl/bin/workqueue-stats-report | |||
| @@ -0,0 +1,6 @@ | |||
| 1 | #!/bin/bash | ||
| 2 | perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl | ||
| 3 | |||
| 4 | |||
| 5 | |||
| 6 | |||
diff --git a/tools/perf/scripts/perl/check-perf-trace.pl b/tools/perf/scripts/perl/check-perf-trace.pl new file mode 100644 index 000000000000..4e7dc0a407a5 --- /dev/null +++ b/tools/perf/scripts/perl/check-perf-trace.pl | |||
| @@ -0,0 +1,106 @@ | |||
| 1 | # perf trace event handlers, generated by perf trace -g perl | ||
| 2 | # (c) 2009, Tom Zanussi <tzanussi@gmail.com> | ||
| 3 | # Licensed under the terms of the GNU GPL License version 2 | ||
| 4 | |||
| 5 | # This script tests basic functionality such as flag and symbol | ||
| 6 | # strings, common_xxx() calls back into perf, begin, end, unhandled | ||
| 7 | # events, etc. Basically, if this script runs successfully and | ||
| 8 | # displays expected results, perl scripting support should be ok. | ||
| 9 | |||
| 10 | use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; | ||
| 11 | use lib "./Perf-Trace-Util/lib"; | ||
| 12 | use Perf::Trace::Core; | ||
| 13 | use Perf::Trace::Context; | ||
| 14 | use Perf::Trace::Util; | ||
| 15 | |||
| 16 | sub trace_begin | ||
| 17 | { | ||
| 18 | print "trace_begin\n"; | ||
| 19 | } | ||
| 20 | |||
| 21 | sub trace_end | ||
| 22 | { | ||
| 23 | print "trace_end\n"; | ||
| 24 | |||
| 25 | print_unhandled(); | ||
| 26 | } | ||
| 27 | |||
| 28 | sub irq::softirq_entry | ||
| 29 | { | ||
| 30 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 31 | $common_pid, $common_comm, | ||
| 32 | $vec) = @_; | ||
| 33 | |||
| 34 | print_header($event_name, $common_cpu, $common_secs, $common_nsecs, | ||
| 35 | $common_pid, $common_comm); | ||
| 36 | |||
| 37 | print_uncommon($context); | ||
| 38 | |||
| 39 | printf("vec=%s\n", | ||
| 40 | symbol_str("irq::softirq_entry", "vec", $vec)); | ||
| 41 | } | ||
| 42 | |||
| 43 | sub kmem::kmalloc | ||
| 44 | { | ||
| 45 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 46 | $common_pid, $common_comm, | ||
| 47 | $call_site, $ptr, $bytes_req, $bytes_alloc, | ||
| 48 | $gfp_flags) = @_; | ||
| 49 | |||
| 50 | print_header($event_name, $common_cpu, $common_secs, $common_nsecs, | ||
| 51 | $common_pid, $common_comm); | ||
| 52 | |||
| 53 | print_uncommon($context); | ||
| 54 | |||
| 55 | printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ". | ||
| 56 | "gfp_flags=%s\n", | ||
| 57 | $call_site, $ptr, $bytes_req, $bytes_alloc, | ||
| 58 | |||
| 59 | flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags)); | ||
| 60 | } | ||
| 61 | |||
| 62 | # print trace fields not included in handler args | ||
| 63 | sub print_uncommon | ||
| 64 | { | ||
| 65 | my ($context) = @_; | ||
| 66 | |||
| 67 | printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ", | ||
| 68 | common_pc($context), trace_flag_str(common_flags($context)), | ||
| 69 | common_lock_depth($context)); | ||
| 70 | |||
| 71 | } | ||
| 72 | |||
| 73 | my %unhandled; | ||
| 74 | |||
| 75 | sub print_unhandled | ||
| 76 | { | ||
| 77 | if ((scalar keys %unhandled) == 0) { | ||
| 78 | return; | ||
| 79 | } | ||
| 80 | |||
| 81 | print "\nunhandled events:\n\n"; | ||
| 82 | |||
| 83 | printf("%-40s %10s\n", "event", "count"); | ||
| 84 | printf("%-40s %10s\n", "----------------------------------------", | ||
| 85 | "-----------"); | ||
| 86 | |||
| 87 | foreach my $event_name (keys %unhandled) { | ||
| 88 | printf("%-40s %10d\n", $event_name, $unhandled{$event_name}); | ||
| 89 | } | ||
| 90 | } | ||
| 91 | |||
| 92 | sub trace_unhandled | ||
| 93 | { | ||
| 94 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 95 | $common_pid, $common_comm) = @_; | ||
| 96 | |||
| 97 | $unhandled{$event_name}++; | ||
| 98 | } | ||
| 99 | |||
| 100 | sub print_header | ||
| 101 | { | ||
| 102 | my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_; | ||
| 103 | |||
| 104 | printf("%-20s %5u %05u.%09u %8u %-20s ", | ||
| 105 | $event_name, $cpu, $secs, $nsecs, $pid, $comm); | ||
| 106 | } | ||
diff --git a/tools/perf/scripts/perl/rw-by-file.pl b/tools/perf/scripts/perl/rw-by-file.pl new file mode 100644 index 000000000000..61f91561d848 --- /dev/null +++ b/tools/perf/scripts/perl/rw-by-file.pl | |||
| @@ -0,0 +1,105 @@ | |||
| 1 | #!/usr/bin/perl -w | ||
| 2 | # (c) 2009, Tom Zanussi <tzanussi@gmail.com> | ||
| 3 | # Licensed under the terms of the GNU GPL License version 2 | ||
| 4 | |||
| 5 | # Display r/w activity for files read/written to for a given program | ||
| 6 | |||
| 7 | # The common_* event handler fields are the most useful fields common to | ||
| 8 | # all events. They don't necessarily correspond to the 'common_*' fields | ||
| 9 | # in the status files. Those fields not available as handler params can | ||
| 10 | # be retrieved via script functions of the form get_common_*(). | ||
| 11 | |||
| 12 | use 5.010000; | ||
| 13 | use strict; | ||
| 14 | use warnings; | ||
| 15 | |||
| 16 | use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; | ||
| 17 | use lib "./Perf-Trace-Util/lib"; | ||
| 18 | use Perf::Trace::Core; | ||
| 19 | use Perf::Trace::Util; | ||
| 20 | |||
| 21 | # change this to the comm of the program you're interested in | ||
| 22 | my $for_comm = "perf"; | ||
| 23 | |||
| 24 | my %reads; | ||
| 25 | my %writes; | ||
| 26 | |||
| 27 | sub syscalls::sys_enter_read | ||
| 28 | { | ||
| 29 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 30 | $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_; | ||
| 31 | |||
| 32 | if ($common_comm eq $for_comm) { | ||
| 33 | $reads{$fd}{bytes_requested} += $count; | ||
| 34 | $reads{$fd}{total_reads}++; | ||
| 35 | } | ||
| 36 | } | ||
| 37 | |||
| 38 | sub syscalls::sys_enter_write | ||
| 39 | { | ||
| 40 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 41 | $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_; | ||
| 42 | |||
| 43 | if ($common_comm eq $for_comm) { | ||
| 44 | $writes{$fd}{bytes_written} += $count; | ||
| 45 | $writes{$fd}{total_writes}++; | ||
| 46 | } | ||
| 47 | } | ||
| 48 | |||
| 49 | sub trace_end | ||
| 50 | { | ||
| 51 | printf("file read counts for $for_comm:\n\n"); | ||
| 52 | |||
| 53 | printf("%6s %10s %10s\n", "fd", "# reads", "bytes_requested"); | ||
| 54 | printf("%6s %10s %10s\n", "------", "----------", "-----------"); | ||
| 55 | |||
| 56 | foreach my $fd (sort {$reads{$b}{bytes_requested} <=> | ||
| 57 | $reads{$a}{bytes_requested}} keys %reads) { | ||
| 58 | my $total_reads = $reads{$fd}{total_reads}; | ||
| 59 | my $bytes_requested = $reads{$fd}{bytes_requested}; | ||
| 60 | printf("%6u %10u %10u\n", $fd, $total_reads, $bytes_requested); | ||
| 61 | } | ||
| 62 | |||
| 63 | printf("\nfile write counts for $for_comm:\n\n"); | ||
| 64 | |||
| 65 | printf("%6s %10s %10s\n", "fd", "# writes", "bytes_written"); | ||
| 66 | printf("%6s %10s %10s\n", "------", "----------", "-----------"); | ||
| 67 | |||
| 68 | foreach my $fd (sort {$writes{$b}{bytes_written} <=> | ||
| 69 | $writes{$a}{bytes_written}} keys %writes) { | ||
| 70 | my $total_writes = $writes{$fd}{total_writes}; | ||
| 71 | my $bytes_written = $writes{$fd}{bytes_written}; | ||
| 72 | printf("%6u %10u %10u\n", $fd, $total_writes, $bytes_written); | ||
| 73 | } | ||
| 74 | |||
| 75 | print_unhandled(); | ||
| 76 | } | ||
| 77 | |||
| 78 | my %unhandled; | ||
| 79 | |||
| 80 | sub print_unhandled | ||
| 81 | { | ||
| 82 | if ((scalar keys %unhandled) == 0) { | ||
| 83 | return; | ||
| 84 | } | ||
| 85 | |||
| 86 | print "\nunhandled events:\n\n"; | ||
| 87 | |||
| 88 | printf("%-40s %10s\n", "event", "count"); | ||
| 89 | printf("%-40s %10s\n", "----------------------------------------", | ||
| 90 | "-----------"); | ||
| 91 | |||
| 92 | foreach my $event_name (keys %unhandled) { | ||
| 93 | printf("%-40s %10d\n", $event_name, $unhandled{$event_name}); | ||
| 94 | } | ||
| 95 | } | ||
| 96 | |||
| 97 | sub trace_unhandled | ||
| 98 | { | ||
| 99 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 100 | $common_pid, $common_comm) = @_; | ||
| 101 | |||
| 102 | $unhandled{$event_name}++; | ||
| 103 | } | ||
| 104 | |||
| 105 | |||
diff --git a/tools/perf/scripts/perl/rw-by-pid.pl b/tools/perf/scripts/perl/rw-by-pid.pl new file mode 100644 index 000000000000..da601fae1a00 --- /dev/null +++ b/tools/perf/scripts/perl/rw-by-pid.pl | |||
| @@ -0,0 +1,170 @@ | |||
| 1 | #!/usr/bin/perl -w | ||
| 2 | # (c) 2009, Tom Zanussi <tzanussi@gmail.com> | ||
| 3 | # Licensed under the terms of the GNU GPL License version 2 | ||
| 4 | |||
| 5 | # Display r/w activity for all processes | ||
| 6 | |||
| 7 | # The common_* event handler fields are the most useful fields common to | ||
| 8 | # all events. They don't necessarily correspond to the 'common_*' fields | ||
| 9 | # in the status files. Those fields not available as handler params can | ||
| 10 | # be retrieved via script functions of the form get_common_*(). | ||
| 11 | |||
| 12 | use 5.010000; | ||
| 13 | use strict; | ||
| 14 | use warnings; | ||
| 15 | |||
| 16 | use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; | ||
| 17 | use lib "./Perf-Trace-Util/lib"; | ||
| 18 | use Perf::Trace::Core; | ||
| 19 | use Perf::Trace::Util; | ||
| 20 | |||
| 21 | my %reads; | ||
| 22 | my %writes; | ||
| 23 | |||
| 24 | sub syscalls::sys_exit_read | ||
| 25 | { | ||
| 26 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 27 | $common_pid, $common_comm, | ||
| 28 | $nr, $ret) = @_; | ||
| 29 | |||
| 30 | if ($ret > 0) { | ||
| 31 | $reads{$common_pid}{bytes_read} += $ret; | ||
| 32 | } else { | ||
| 33 | if (!defined ($reads{$common_pid}{bytes_read})) { | ||
| 34 | $reads{$common_pid}{bytes_read} = 0; | ||
| 35 | } | ||
| 36 | $reads{$common_pid}{errors}{$ret}++; | ||
| 37 | } | ||
| 38 | } | ||
| 39 | |||
| 40 | sub syscalls::sys_enter_read | ||
| 41 | { | ||
| 42 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 43 | $common_pid, $common_comm, | ||
| 44 | $nr, $fd, $buf, $count) = @_; | ||
| 45 | |||
| 46 | $reads{$common_pid}{bytes_requested} += $count; | ||
| 47 | $reads{$common_pid}{total_reads}++; | ||
| 48 | $reads{$common_pid}{comm} = $common_comm; | ||
| 49 | } | ||
| 50 | |||
| 51 | sub syscalls::sys_exit_write | ||
| 52 | { | ||
| 53 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 54 | $common_pid, $common_comm, | ||
| 55 | $nr, $ret) = @_; | ||
| 56 | |||
| 57 | if ($ret <= 0) { | ||
| 58 | $writes{$common_pid}{errors}{$ret}++; | ||
| 59 | } | ||
| 60 | } | ||
| 61 | |||
| 62 | sub syscalls::sys_enter_write | ||
| 63 | { | ||
| 64 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 65 | $common_pid, $common_comm, | ||
| 66 | $nr, $fd, $buf, $count) = @_; | ||
| 67 | |||
| 68 | $writes{$common_pid}{bytes_written} += $count; | ||
| 69 | $writes{$common_pid}{total_writes}++; | ||
| 70 | $writes{$common_pid}{comm} = $common_comm; | ||
| 71 | } | ||
| 72 | |||
| 73 | sub trace_end | ||
| 74 | { | ||
| 75 | printf("read counts by pid:\n\n"); | ||
| 76 | |||
| 77 | printf("%6s %20s %10s %10s %10s\n", "pid", "comm", | ||
| 78 | "# reads", "bytes_requested", "bytes_read"); | ||
| 79 | printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------", | ||
| 80 | "-----------", "----------", "----------"); | ||
| 81 | |||
| 82 | foreach my $pid (sort {$reads{$b}{bytes_read} <=> | ||
| 83 | $reads{$a}{bytes_read}} keys %reads) { | ||
| 84 | my $comm = $reads{$pid}{comm}; | ||
| 85 | my $total_reads = $reads{$pid}{total_reads}; | ||
| 86 | my $bytes_requested = $reads{$pid}{bytes_requested}; | ||
| 87 | my $bytes_read = $reads{$pid}{bytes_read}; | ||
| 88 | |||
| 89 | printf("%6s %-20s %10s %10s %10s\n", $pid, $comm, | ||
| 90 | $total_reads, $bytes_requested, $bytes_read); | ||
| 91 | } | ||
| 92 | |||
| 93 | printf("\nfailed reads by pid:\n\n"); | ||
| 94 | |||
| 95 | printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors"); | ||
| 96 | printf("%6s %20s %6s %10s\n", "------", "--------------------", | ||
| 97 | "------", "----------"); | ||
| 98 | |||
| 99 | foreach my $pid (keys %reads) { | ||
| 100 | my $comm = $reads{$pid}{comm}; | ||
| 101 | foreach my $err (sort {$reads{$b}{comm} cmp $reads{$a}{comm}} | ||
| 102 | keys %{$reads{$pid}{errors}}) { | ||
| 103 | my $errors = $reads{$pid}{errors}{$err}; | ||
| 104 | |||
| 105 | printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors); | ||
| 106 | } | ||
| 107 | } | ||
| 108 | |||
| 109 | printf("\nwrite counts by pid:\n\n"); | ||
| 110 | |||
| 111 | printf("%6s %20s %10s %10s\n", "pid", "comm", | ||
| 112 | "# writes", "bytes_written"); | ||
| 113 | printf("%6s %-20s %10s %10s\n", "------", "--------------------", | ||
| 114 | "-----------", "----------"); | ||
| 115 | |||
| 116 | foreach my $pid (sort {$writes{$b}{bytes_written} <=> | ||
| 117 | $writes{$a}{bytes_written}} keys %writes) { | ||
| 118 | my $comm = $writes{$pid}{comm}; | ||
| 119 | my $total_writes = $writes{$pid}{total_writes}; | ||
| 120 | my $bytes_written = $writes{$pid}{bytes_written}; | ||
| 121 | |||
| 122 | printf("%6s %-20s %10s %10s\n", $pid, $comm, | ||
| 123 | $total_writes, $bytes_written); | ||
| 124 | } | ||
| 125 | |||
| 126 | printf("\nfailed writes by pid:\n\n"); | ||
| 127 | |||
| 128 | printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors"); | ||
| 129 | printf("%6s %20s %6s %10s\n", "------", "--------------------", | ||
| 130 | "------", "----------"); | ||
| 131 | |||
| 132 | foreach my $pid (keys %writes) { | ||
| 133 | my $comm = $writes{$pid}{comm}; | ||
| 134 | foreach my $err (sort {$writes{$b}{comm} cmp $writes{$a}{comm}} | ||
| 135 | keys %{$writes{$pid}{errors}}) { | ||
| 136 | my $errors = $writes{$pid}{errors}{$err}; | ||
| 137 | |||
| 138 | printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors); | ||
| 139 | } | ||
| 140 | } | ||
| 141 | |||
| 142 | print_unhandled(); | ||
| 143 | } | ||
| 144 | |||
| 145 | my %unhandled; | ||
| 146 | |||
| 147 | sub print_unhandled | ||
| 148 | { | ||
| 149 | if ((scalar keys %unhandled) == 0) { | ||
| 150 | return; | ||
| 151 | } | ||
| 152 | |||
| 153 | print "\nunhandled events:\n\n"; | ||
| 154 | |||
| 155 | printf("%-40s %10s\n", "event", "count"); | ||
| 156 | printf("%-40s %10s\n", "----------------------------------------", | ||
| 157 | "-----------"); | ||
| 158 | |||
| 159 | foreach my $event_name (keys %unhandled) { | ||
| 160 | printf("%-40s %10d\n", $event_name, $unhandled{$event_name}); | ||
| 161 | } | ||
| 162 | } | ||
| 163 | |||
| 164 | sub trace_unhandled | ||
| 165 | { | ||
| 166 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 167 | $common_pid, $common_comm) = @_; | ||
| 168 | |||
| 169 | $unhandled{$event_name}++; | ||
| 170 | } | ||
diff --git a/tools/perf/scripts/perl/wakeup-latency.pl b/tools/perf/scripts/perl/wakeup-latency.pl new file mode 100644 index 000000000000..ed58ef284e23 --- /dev/null +++ b/tools/perf/scripts/perl/wakeup-latency.pl | |||
| @@ -0,0 +1,103 @@ | |||
| 1 | #!/usr/bin/perl -w | ||
| 2 | # (c) 2009, Tom Zanussi <tzanussi@gmail.com> | ||
| 3 | # Licensed under the terms of the GNU GPL License version 2 | ||
| 4 | |||
| 5 | # Display avg/min/max wakeup latency | ||
| 6 | |||
| 7 | # The common_* event handler fields are the most useful fields common to | ||
| 8 | # all events. They don't necessarily correspond to the 'common_*' fields | ||
| 9 | # in the status files. Those fields not available as handler params can | ||
| 10 | # be retrieved via script functions of the form get_common_*(). | ||
| 11 | |||
| 12 | use 5.010000; | ||
| 13 | use strict; | ||
| 14 | use warnings; | ||
| 15 | |||
| 16 | use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; | ||
| 17 | use lib "./Perf-Trace-Util/lib"; | ||
| 18 | use Perf::Trace::Core; | ||
| 19 | use Perf::Trace::Util; | ||
| 20 | |||
| 21 | my %last_wakeup; | ||
| 22 | |||
| 23 | my $max_wakeup_latency; | ||
| 24 | my $min_wakeup_latency; | ||
| 25 | my $total_wakeup_latency; | ||
| 26 | my $total_wakeups; | ||
| 27 | |||
| 28 | sub sched::sched_switch | ||
| 29 | { | ||
| 30 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 31 | $common_pid, $common_comm, | ||
| 32 | $prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid, | ||
| 33 | $next_prio) = @_; | ||
| 34 | |||
| 35 | my $wakeup_ts = $last_wakeup{$common_cpu}{ts}; | ||
| 36 | if ($wakeup_ts) { | ||
| 37 | my $switch_ts = nsecs($common_secs, $common_nsecs); | ||
| 38 | my $wakeup_latency = $switch_ts - $wakeup_ts; | ||
| 39 | if ($wakeup_latency > $max_wakeup_latency) { | ||
| 40 | $max_wakeup_latency = $wakeup_latency; | ||
| 41 | } | ||
| 42 | if ($wakeup_latency < $min_wakeup_latency) { | ||
| 43 | $min_wakeup_latency = $wakeup_latency; | ||
| 44 | } | ||
| 45 | $total_wakeup_latency += $wakeup_latency; | ||
| 46 | $total_wakeups++; | ||
| 47 | } | ||
| 48 | $last_wakeup{$common_cpu}{ts} = 0; | ||
| 49 | } | ||
| 50 | |||
| 51 | sub sched::sched_wakeup | ||
| 52 | { | ||
| 53 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 54 | $common_pid, $common_comm, | ||
| 55 | $comm, $pid, $prio, $success, $target_cpu) = @_; | ||
| 56 | |||
| 57 | $last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs); | ||
| 58 | } | ||
| 59 | |||
| 60 | sub trace_begin | ||
| 61 | { | ||
| 62 | $min_wakeup_latency = 1000000000; | ||
| 63 | $max_wakeup_latency = 0; | ||
| 64 | } | ||
| 65 | |||
| 66 | sub trace_end | ||
| 67 | { | ||
| 68 | printf("wakeup_latency stats:\n\n"); | ||
| 69 | print "total_wakeups: $total_wakeups\n"; | ||
| 70 | printf("avg_wakeup_latency (ns): %u\n", | ||
| 71 | avg($total_wakeup_latency, $total_wakeups)); | ||
| 72 | printf("min_wakeup_latency (ns): %u\n", $min_wakeup_latency); | ||
| 73 | printf("max_wakeup_latency (ns): %u\n", $max_wakeup_latency); | ||
| 74 | |||
| 75 | print_unhandled(); | ||
| 76 | } | ||
| 77 | |||
| 78 | my %unhandled; | ||
| 79 | |||
| 80 | sub print_unhandled | ||
| 81 | { | ||
| 82 | if ((scalar keys %unhandled) == 0) { | ||
| 83 | return; | ||
| 84 | } | ||
| 85 | |||
| 86 | print "\nunhandled events:\n\n"; | ||
| 87 | |||
| 88 | printf("%-40s %10s\n", "event", "count"); | ||
| 89 | printf("%-40s %10s\n", "----------------------------------------", | ||
| 90 | "-----------"); | ||
| 91 | |||
| 92 | foreach my $event_name (keys %unhandled) { | ||
| 93 | printf("%-40s %10d\n", $event_name, $unhandled{$event_name}); | ||
| 94 | } | ||
| 95 | } | ||
| 96 | |||
| 97 | sub trace_unhandled | ||
| 98 | { | ||
| 99 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 100 | $common_pid, $common_comm) = @_; | ||
| 101 | |||
| 102 | $unhandled{$event_name}++; | ||
| 103 | } | ||
diff --git a/tools/perf/scripts/perl/workqueue-stats.pl b/tools/perf/scripts/perl/workqueue-stats.pl new file mode 100644 index 000000000000..511302c8a494 --- /dev/null +++ b/tools/perf/scripts/perl/workqueue-stats.pl | |||
| @@ -0,0 +1,129 @@ | |||
| 1 | #!/usr/bin/perl -w | ||
| 2 | # (c) 2009, Tom Zanussi <tzanussi@gmail.com> | ||
| 3 | # Licensed under the terms of the GNU GPL License version 2 | ||
| 4 | |||
| 5 | # Displays workqueue stats | ||
| 6 | # | ||
| 7 | # Usage: | ||
| 8 | # | ||
| 9 | # perf record -c 1 -f -a -R -e workqueue:workqueue_creation -e | ||
| 10 | # workqueue:workqueue_destruction -e workqueue:workqueue_execution | ||
| 11 | # -e workqueue:workqueue_insertion | ||
| 12 | # | ||
| 13 | # perf trace -p -s tools/perf/scripts/perl/workqueue-stats.pl | ||
| 14 | |||
| 15 | use 5.010000; | ||
| 16 | use strict; | ||
| 17 | use warnings; | ||
| 18 | |||
| 19 | use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib"; | ||
| 20 | use lib "./Perf-Trace-Util/lib"; | ||
| 21 | use Perf::Trace::Core; | ||
| 22 | use Perf::Trace::Util; | ||
| 23 | |||
| 24 | my @cpus; | ||
| 25 | |||
| 26 | sub workqueue::workqueue_destruction | ||
| 27 | { | ||
| 28 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 29 | $common_pid, $common_comm, | ||
| 30 | $thread_comm, $thread_pid) = @_; | ||
| 31 | |||
| 32 | $cpus[$common_cpu]{$thread_pid}{destroyed}++; | ||
| 33 | $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm; | ||
| 34 | } | ||
| 35 | |||
| 36 | sub workqueue::workqueue_creation | ||
| 37 | { | ||
| 38 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 39 | $common_pid, $common_comm, | ||
| 40 | $thread_comm, $thread_pid, $cpu) = @_; | ||
| 41 | |||
| 42 | $cpus[$common_cpu]{$thread_pid}{created}++; | ||
| 43 | $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm; | ||
| 44 | } | ||
| 45 | |||
| 46 | sub workqueue::workqueue_execution | ||
| 47 | { | ||
| 48 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 49 | $common_pid, $common_comm, | ||
| 50 | $thread_comm, $thread_pid, $func) = @_; | ||
| 51 | |||
| 52 | $cpus[$common_cpu]{$thread_pid}{executed}++; | ||
| 53 | $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm; | ||
| 54 | } | ||
| 55 | |||
| 56 | sub workqueue::workqueue_insertion | ||
| 57 | { | ||
| 58 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 59 | $common_pid, $common_comm, | ||
| 60 | $thread_comm, $thread_pid, $func) = @_; | ||
| 61 | |||
| 62 | $cpus[$common_cpu]{$thread_pid}{inserted}++; | ||
| 63 | $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm; | ||
| 64 | } | ||
| 65 | |||
| 66 | sub trace_end | ||
| 67 | { | ||
| 68 | print "workqueue work stats:\n\n"; | ||
| 69 | my $cpu = 0; | ||
| 70 | printf("%3s %6s %6s\t%-20s\n", "cpu", "ins", "exec", "name"); | ||
| 71 | printf("%3s %6s %6s\t%-20s\n", "---", "---", "----", "----"); | ||
| 72 | foreach my $pidhash (@cpus) { | ||
| 73 | while ((my $pid, my $wqhash) = each %$pidhash) { | ||
| 74 | my $ins = $$wqhash{'inserted'}; | ||
| 75 | my $exe = $$wqhash{'executed'}; | ||
| 76 | my $comm = $$wqhash{'comm'}; | ||
| 77 | if ($ins || $exe) { | ||
| 78 | printf("%3u %6u %6u\t%-20s\n", $cpu, $ins, $exe, $comm); | ||
| 79 | } | ||
| 80 | } | ||
| 81 | $cpu++; | ||
| 82 | } | ||
| 83 | |||
| 84 | $cpu = 0; | ||
| 85 | print "\nworkqueue lifecycle stats:\n\n"; | ||
| 86 | printf("%3s %6s %6s\t%-20s\n", "cpu", "created", "destroyed", "name"); | ||
| 87 | printf("%3s %6s %6s\t%-20s\n", "---", "-------", "---------", "----"); | ||
| 88 | foreach my $pidhash (@cpus) { | ||
| 89 | while ((my $pid, my $wqhash) = each %$pidhash) { | ||
| 90 | my $created = $$wqhash{'created'}; | ||
| 91 | my $destroyed = $$wqhash{'destroyed'}; | ||
| 92 | my $comm = $$wqhash{'comm'}; | ||
| 93 | if ($created || $destroyed) { | ||
| 94 | printf("%3u %6u %6u\t%-20s\n", $cpu, $created, $destroyed, | ||
| 95 | $comm); | ||
| 96 | } | ||
| 97 | } | ||
| 98 | $cpu++; | ||
| 99 | } | ||
| 100 | |||
| 101 | print_unhandled(); | ||
| 102 | } | ||
| 103 | |||
| 104 | my %unhandled; | ||
| 105 | |||
| 106 | sub print_unhandled | ||
| 107 | { | ||
| 108 | if ((scalar keys %unhandled) == 0) { | ||
| 109 | return; | ||
| 110 | } | ||
| 111 | |||
| 112 | print "\nunhandled events:\n\n"; | ||
| 113 | |||
| 114 | printf("%-40s %10s\n", "event", "count"); | ||
| 115 | printf("%-40s %10s\n", "----------------------------------------", | ||
| 116 | "-----------"); | ||
| 117 | |||
| 118 | foreach my $event_name (keys %unhandled) { | ||
| 119 | printf("%-40s %10d\n", $event_name, $unhandled{$event_name}); | ||
| 120 | } | ||
| 121 | } | ||
| 122 | |||
| 123 | sub trace_unhandled | ||
| 124 | { | ||
| 125 | my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs, | ||
| 126 | $common_pid, $common_comm) = @_; | ||
| 127 | |||
| 128 | $unhandled{$event_name}++; | ||
| 129 | } | ||
