diff options
Diffstat (limited to 'tools/perf/scripts/perl')
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 | } | ||