diff options
author | Tom Zanussi <tzanussi@gmail.com> | 2009-11-25 02:15:49 -0500 |
---|---|---|
committer | Ingo Molnar <mingo@elte.hu> | 2009-11-28 04:04:26 -0500 |
commit | bcefe12eff5dca6fdfa94ed85e5bee66380d5cd9 (patch) | |
tree | 9a0f39f63d4e542322f4bc58626e1bd1d3d0f3c1 | |
parent | 16c632de64a74644a46e7636db26b2cfb530ca13 (diff) |
perf trace: Add perf trace scripting support modules for Perl
Add Perf-Trace-Util Perl module and some scripts that use it.
Core.pm contains Perl code to define and access flag and
symbolic fields. Util.pm contains general-purpose utility
functions.
Also adds some makefile bits to install them in
libexec/perf-core/scripts/perl (or wherever perfexec_instdir
points).
Signed-off-by: Tom Zanussi <tzanussi@gmail.com>
Cc: fweisbec@gmail.com
Cc: rostedt@goodmis.org
Cc: anton@samba.org
Cc: hch@infradead.org
LKML-Reference: <1259133352-23685-5-git-send-email-tzanussi@gmail.com>
Signed-off-by: Ingo Molnar <mingo@elte.hu>
-rw-r--r-- | tools/perf/Makefile | 7 | ||||
-rw-r--r-- | tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL | 12 | ||||
-rw-r--r-- | tools/perf/scripts/perl/Perf-Trace-Util/README | 35 | ||||
-rw-r--r-- | tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | 157 | ||||
-rw-r--r-- | tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm | 88 | ||||
-rw-r--r-- | tools/perf/scripts/perl/rw-by-file.pl | 105 | ||||
-rw-r--r-- | tools/perf/scripts/perl/rw-by-pid.pl | 170 | ||||
-rw-r--r-- | tools/perf/scripts/perl/wakeup-latency.pl | 103 | ||||
-rw-r--r-- | tools/perf/scripts/perl/workqueue-stats.pl | 129 |
9 files changed, 806 insertions, 0 deletions
diff --git a/tools/perf/Makefile b/tools/perf/Makefile index 19e37cd14ae4..efbc0e864212 100644 --- a/tools/perf/Makefile +++ b/tools/perf/Makefile | |||
@@ -980,6 +980,13 @@ export perfexec_instdir | |||
980 | install: all | 980 | install: all |
981 | $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)' | 981 | $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)' |
982 | $(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)' | 982 | $(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)' |
983 | $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace' | ||
984 | $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin' | ||
985 | $(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace' | ||
986 | $(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl' | ||
987 | $(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin' | ||
988 | $(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util' | ||
989 | $(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util' | ||
983 | ifdef BUILT_INS | 990 | ifdef BUILT_INS |
984 | $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' | 991 | $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' |
985 | $(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' | 992 | $(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' |
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..b0de02e6950d --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL | |||
@@ -0,0 +1,12 @@ | |||
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::Util', | ||
7 | VERSION_FROM => 'lib/Perf/Trace/Util.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/Util.pm', # retrieve abstract from module | ||
11 | AUTHOR => 'Tom Zanussi <tzanussi@gmail.com>') : ()), | ||
12 | ); | ||
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..0a58378f0836 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/README | |||
@@ -0,0 +1,35 @@ | |||
1 | Perf-Trace-Util version 0.01 | ||
2 | ============================ | ||
3 | |||
4 | This module contains utility functions for use with perf trace. | ||
5 | |||
6 | INSTALLATION | ||
7 | |||
8 | Building perf with perf trace Perl scripting should install this | ||
9 | module in the right place. | ||
10 | |||
11 | You should make sure libperl is installed first e.g. apt-get install | ||
12 | libperl-dev. | ||
13 | |||
14 | DEPENDENCIES | ||
15 | |||
16 | This module requires these other modules and libraries: | ||
17 | |||
18 | blah blah blah | ||
19 | |||
20 | COPYRIGHT AND LICENCE | ||
21 | |||
22 | Put the correct copyright and licence information here. | ||
23 | |||
24 | Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com> | ||
25 | |||
26 | This library is free software; you can redistribute it and/or modify | ||
27 | it under the same terms as Perl itself, either Perl version 5.10.0 or, | ||
28 | at your option, any later version of Perl 5 you may have available. | ||
29 | |||
30 | Alternatively, this software may be distributed under the terms of the | ||
31 | GNU General Public License ("GPL") version 2 as published by the Free | ||
32 | Software Foundation. | ||
33 | |||
34 | |||
35 | |||
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..fd250fb7be16 --- /dev/null +++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | |||
@@ -0,0 +1,157 @@ | |||
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 | ); | ||
20 | |||
21 | our $VERSION = '0.01'; | ||
22 | |||
23 | my %flag_fields; | ||
24 | my %symbolic_fields; | ||
25 | |||
26 | sub flag_str | ||
27 | { | ||
28 | my ($event_name, $field_name, $value) = @_; | ||
29 | |||
30 | my $string; | ||
31 | |||
32 | if ($flag_fields{$event_name}{$field_name}) { | ||
33 | my $print_delim = 0; | ||
34 | foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) { | ||
35 | if (!$value && !$idx) { | ||
36 | $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
37 | last; | ||
38 | } | ||
39 | if ($idx && ($value & $idx) == $idx) { | ||
40 | if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) { | ||
41 | $string .= " $flag_fields{$event_name}{$field_name}{'delim'} "; | ||
42 | } | ||
43 | $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
44 | $print_delim = 1; | ||
45 | $value &= ~$idx; | ||
46 | } | ||
47 | } | ||
48 | } | ||
49 | |||
50 | return $string; | ||
51 | } | ||
52 | |||
53 | sub define_flag_field | ||
54 | { | ||
55 | my ($event_name, $field_name, $delim) = @_; | ||
56 | |||
57 | $flag_fields{$event_name}{$field_name}{"delim"} = $delim; | ||
58 | } | ||
59 | |||
60 | sub define_flag_value | ||
61 | { | ||
62 | my ($event_name, $field_name, $value, $field_str) = @_; | ||
63 | |||
64 | $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str; | ||
65 | } | ||
66 | |||
67 | sub dump_flag_fields | ||
68 | { | ||
69 | for my $event (keys %flag_fields) { | ||
70 | print "event $event:\n"; | ||
71 | for my $field (keys %{$flag_fields{$event}}) { | ||
72 | print " field: $field:\n"; | ||
73 | print " delim: $flag_fields{$event}{$field}{'delim'}\n"; | ||
74 | foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) { | ||
75 | print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n"; | ||
76 | } | ||
77 | } | ||
78 | } | ||
79 | } | ||
80 | |||
81 | sub symbol_str | ||
82 | { | ||
83 | my ($event_name, $field_name, $value) = @_; | ||
84 | |||
85 | if ($symbolic_fields{$event_name}{$field_name}) { | ||
86 | foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) { | ||
87 | if (!$value && !$idx) { | ||
88 | return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
89 | last; | ||
90 | } | ||
91 | if ($value == $idx) { | ||
92 | return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}"; | ||
93 | } | ||
94 | } | ||
95 | } | ||
96 | |||
97 | return undef; | ||
98 | } | ||
99 | |||
100 | sub define_symbolic_field | ||
101 | { | ||
102 | my ($event_name, $field_name) = @_; | ||
103 | |||
104 | # nothing to do, really | ||
105 | } | ||
106 | |||
107 | sub define_symbolic_value | ||
108 | { | ||
109 | my ($event_name, $field_name, $value, $field_str) = @_; | ||
110 | |||
111 | $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str; | ||
112 | } | ||
113 | |||
114 | sub dump_symbolic_fields | ||
115 | { | ||
116 | for my $event (keys %symbolic_fields) { | ||
117 | print "event $event:\n"; | ||
118 | for my $field (keys %{$symbolic_fields{$event}}) { | ||
119 | print " field: $field:\n"; | ||
120 | foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) { | ||
121 | print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n"; | ||
122 | } | ||
123 | } | ||
124 | } | ||
125 | } | ||
126 | |||
127 | 1; | ||
128 | __END__ | ||
129 | =head1 NAME | ||
130 | |||
131 | Perf::Trace::Core - Perl extension for perf trace | ||
132 | |||
133 | =head1 SYNOPSIS | ||
134 | |||
135 | use Perf::Trace::Core | ||
136 | |||
137 | =head1 SEE ALSO | ||
138 | |||
139 | Perf (trace) documentation | ||
140 | |||
141 | =head1 AUTHOR | ||
142 | |||
143 | Tom Zanussi, E<lt>tzanussi@gmail.com<gt> | ||
144 | |||
145 | =head1 COPYRIGHT AND LICENSE | ||
146 | |||
147 | Copyright (C) 2009 by Tom Zanussi | ||
148 | |||
149 | This library is free software; you can redistribute it and/or modify | ||
150 | it under the same terms as Perl itself, either Perl version 5.10.0 or, | ||
151 | at your option, any later version of Perl 5 you may have available. | ||
152 | |||
153 | Alternatively, this software may be distributed under the terms of the | ||
154 | GNU General Public License ("GPL") version 2 as published by the Free | ||
155 | Software Foundation. | ||
156 | |||
157 | =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/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 | } | ||