diff options
| -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 19e37cd14ae..efbc0e86421 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 00000000000..b0de02e6950 --- /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 00000000000..0a58378f083 --- /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 00000000000..fd250fb7be1 --- /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 00000000000..052f132ced2 --- /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 00000000000..61f91561d84 --- /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 00000000000..da601fae1a0 --- /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 00000000000..ed58ef284e2 --- /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 00000000000..511302c8a49 --- /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 | } | ||
