Hi,
Here's a belated update to v1 of the trace stream scripting support
patches I posted last month; I had meant to get this out sooner but
got too busy with other things...
This patchset defines a generic interface for processing the binary
output of 'perf trace' and making it directly available to
user-defined scripts written in general-purpose scripting languages
such as Perl or Python. It also builds a general-purpose Perl
scripting trace processor on top of the new interface and provides a
few example scripts that exercise the basic functionality.
The main motivation behind it is to provide a more efficient and
powerful alternative to the popular method of parsing the ascii trace
output in order to extract useful information from it. To avoid the
overhead and complexity of all that, this patchset provides a
direct-to-script-interpreter pathway for doing the same thing, but in
a more regularized fashion, one that takes advantage of all the event
meta-info provided by the tracing infrustructure, such as the
event/field info contained in the 'format files' designed for that
purpose.
Anyone who still wants to deal with the trace stream as straight ascii
text can still have the scripts generate it (and in fact the interface
provides a way to have event printing code auto-generated. Also, the
original ascii output mode is preserved when the scripting options
aren't used), but for anyone wanting to do something more interesting
with the data using a rapid prototyping language such as Perl, this
patchset makes it easy to do so. It allows the full power of
general-purpose scripting languages to be applied to the trace stream
to do non-trivial analyses, and suddenly makes available huge
libraries of useful tools and modules (e.g. CPAN for Perl) to be
applied to the problem of creating new and interesting trace
applications.
This patchset only implements a Perl interface, but the intention is
to make it relatively easy to add support for other languages such as
Python, Ruby, etc, etc - all they need to do is follow the example of
the Perl implementation and provide their own implementations of the
trace_scripting_ops and supporting functions (more details below).
Changes from v1:
- uses the -M (multiplex) option of perf record instead of the sorting
hack in v1 to order events.
- makes the command-line option for specifying scripts (-s) more
flexible and scalable to the addition of other scripting languages.
- adds a Perl->C interface to provide scripts a way to access event
data not included in event handlers; this, along with a related
context param now passed to handlers, could also be used to access
metadata in the parent perf executable.
- for usability, adds centralized documentation and some simple shell
scripts to avoid having to remember long command lines.
- upgrades the licensing of the Perl modules to GPL
Installation:
For the Perl scripting support to work, you first need to install the
Perl development library, libperl (e.g. apt-get install liberl-dev in
ubuntu), then make and install perf.
Known problems:
None with the code itself, AFAIK, but I do see some strange results in
some scripts when using the perf timestamps. For example, the
wakeup-latency.pl script, if run for a long enough time, will show
output like the following:
root@tropicana:~# wakeup-latency-record
^C[ perf record: Woken up 76 times to write data ]
[ perf record: Captured and wrote 10.831 MB perf.data (~473227 samples) ]
root@tropicana:~# wakeup-latency-report
perf trace started with Perl script /root/libexec/perf-core/scripts/perl/wakeup-
wakeup_latency stats:
total_wakeups: 458359
avg_wakeup_latency (ns): 27974
min_wakeup_latency (ns): 18446744073709546323
max_wakeup_latency (ns): 55234235
perf trace Perl script stopped
Obviously, something is wrong with the min_wakeup_latency stat. To
dig a little further, I added some printing code, which I conveniently
took from the code generated by the new perf trace -g option:
root@tropicana:~# perf trace -g perl
generated Perl script: perf-trace.pl
I copied the generated print() and print_header() code from
perf-trace.pl for the sched_switch() and sched_wakeup() handler
functions and added a line to print the $min_wakeup_latency value
whenever it changes (I've attached the diff from wakeup-latency.pl
below).
After doing that and re-running the wakeup-latency script, I got the
below output, which is the snippet surrounding a negative latency (see
min_wakeup_latency: -5293).
Looking at the two events preceding it, you can see that the
sched_switch has an earlier timestamp than the sched_wakeup event that
preceded it:
sched::sched_wakeup 1 01238.657172818 6186 firefox comm=firefox, pid=7140, prio=120, success=1, target_cpu=1
sched::sched_switch 1 01238.657197514 6186 firefox prev_comm=firefox, prev_pid=6186, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=7140, next_prio=120
sched::sched_switch 0 01238.657881346 4555 kondemand/0 prev_comm=kondemand/0, prev_pid=4555, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6183, next_prio=120
sched::sched_wakeup 0 01238.657997033 6183 firefox comm=firefox, pid=6199, prio=120, success=1, target_cpu=1
sched::sched_switch 1 01238.657991740 7140 firefox prev_comm=firefox, prev_pid=7140, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6199, next_prio=120
min_wakeup_latency: -5293
sched::sched_wakeup 0 01238.658063038 6183 firefox comm=Xorg, pid=5536, prio=140, success=1, target_cpu=0
sched::sched_wakeup 0 01238.658232707 6183 firefox comm=npviewer.bin, pid=6998, prio=120, success=1, target_cpu=1
sched::sched_switch 1 01238.658311152 6199 firefox prev_comm=firefox, prev_pid=6199, prev_prio=120, prev_state=S, next_comm=npviewer.bin, next_pid=6998, next_prio=120
sched::sched_switch 0 01238.658397358 6183 firefox prev_comm=firefox, prev_pid=6183, prev_prio=120, prev_state=S, next_comm=Xorg, next_pid=5536, next_prio=140
sched::sched_wakeup 0 01238.658460734 5536 Xorg comm=firefox, pid=6183, prio=120, success=1, target_cpu=0
sched::sched_switch 1 01238.658311152 6998 npviewer.bin prev_comm=npviewer.bin, prev_pid=6998, prev_prio=120, prev_state=S, next_comm=swapper, next_pid=0, next_prio=140
sched::sched_switch 0 01238.664043515 5536 Xorg prev_comm=Xorg, prev_pid=5536, prev_prio=140, prev_state=R, next_comm=firefox, next_pid=6183, next_prio=120
sched::sched_switch 0 01238.664059065 6183 firefox prev_comm=firefox, prev_pid=6183, prev_prio=120, prev_state=S, next_comm=Xorg, next_pid=5536, next_prio=140
sched::sched_wakeup 0 01238.665301440 5536 Xorg comm=metacity, pid=5924, prio=140, success=1, target_cpu=1
sched::sched_switch 1 01238.665313262 0 init prev_comm=swapper, prev_pid=0, prev_prio=140, prev_state=R, next_comm=metacity, next_pid=5924, next_prio=140
sched::sched_wakeup 0 01238.665314341 5536 Xorg comm=gnome-settings-, pid=5923, prio=140, success=1, target_cpu=0
sched::sched_switch 0 01238.665320692 5536 Xorg prev_comm=Xorg, prev_pid=5536, prev_prio=140, prev_state=R, next_comm=gnome-settings-, next_pid=5923, next_prio=140
So the event ordering seems right, but the timestamps don't. To get
some idea what might be happening, I added a couple of printks to
perf_event_output(), one at the beginning and one at the end and
recorded perf_clock() at those points (since the actual event
timestamping happens somewhere in between).
Whenever the negative latency happens in the script, the perf_clock()
values on the sched_switch cpu seem to get stuck for awhile during
that time. Below is the output from cpu1 - note the timestamp of the
event (01238.657991740), which matches the timestamp at both the
beginning and end of perf_event_output().
The values for cpu0 around that time are also shown for completeness.
cpu1:
perf_event_output begin: ts 1238657171430 cpu 1
perf_event_output end: ts 1238657173618 cpu 1
perf_event_output begin: ts 1238657196431 cpu 1
perf_event_output end: ts 1238657198193 cpu 1
perf_event_output begin: ts 1238657991740 cpu 1
perf_event_output end: ts 1238657991740 cpu 1
perf_event_output begin: ts 1238658311152 cpu 1
perf_event_output end: ts 1238658311152 cpu 1
perf_event_output begin: ts 1238658311152 cpu 1
perf_event_output end: ts 1238658311152 cpu 1
perf_event_output begin: ts 1238665312062 cpu 1
perf_event_output end: ts 1238665314481 cpu 1
perf_event_output begin: ts 1238665414056 cpu 1
cpu0:
perf_event_output end: ts 1238656044814 cpu 0
perf_event_output begin: ts 1238657879958 cpu 0
perf_event_output end: ts 1238657882306 cpu 0
perf_event_output begin: ts 1238657995453 cpu 0
perf_event_output end: ts 1238657997881 cpu 0
perf_event_output begin: ts 1238658061886 cpu 0
perf_event_output end: ts 1238658064203 cpu 0
perf_event_output begin: ts 1238658231296 cpu 0
perf_event_output end: ts 1238658233676 cpu 0
perf_event_output begin: ts 1238658395923 cpu 0
So anyway, it looks like what happens is that clock0 gets stuck at
time t0, event 1 happens on the normally advancing clock1 at time t1 >
t0, event 2 happens after event 1 but because t0 is stuck at t0, gets
time t0 < t1 and thus the negative result.
I haven't investigated any further at this point, except to put in a
few more printks that show it is using the tsc, and to note that you
only get out-of-order timestamps between cpus, though you do get
0-difference timestamps between events on the same cpu, which amounts
to the same thing - I'm hoping someone else might have a better idea
about what's happening and how to fix it, as it obviously limits the
value of the timetamps for analysis.
Other than that things seem to work pretty well. The rest of this
e-mail provides a short introduction to help get you started writing
scripts; as always please see the code for details. There's also
perf-trace-perl Documentation included with this patchset, which might
also be helpful. All of the scripts described below can be found in
~/libexec/perf-core/scripts/perl after you install perf.
The first step in a normal trace session is to run 'perf record' with
a set of tracepoint events you're interested in e.g.:
root@tropicana:~# perf record -c 1 -f -a -M -R -e kmem:kmalloc -e kmem:kfree -e irq:softirq_entry -e irq:softirq_exit -e sched:sched_switch
^C[ perf record: Woken up 1 times to write data ]
[ perf record: Captured and wrote 0.485 MB perf.data (~21198 samples) ]
Next, you can use the -g perl option of perf trace to have it generate
a script with one handler function for each event in the trace:
root@tropicana:~# perf trace -g perl
The name of the generated script will be 'perf-trace.pl':
root@tropicana:~# perf trace -g perl
generated Perl script: perf-trace.pl
Here's a portion of the Perl code generated for this trace, to give
some idea of what a trace script looks like:
# perf trace event handlers, generated by perf trace -g perl
# Licensed under the terms of the GNU GPL License version 2
# The common_* event handler fields are the most useful fields common to
# all events. They don't necessarily correspond to the 'common_*' fields
# in the format files. Those fields not available as handler params can
# be retrieved using Perl functions of the form common_*($context).
# See Context.pm for the list of available functions.
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
use lib "./Perf-Trace-Util/lib";
use Perf::Trace::Core;
use Perf::Trace::Context;
use Perf::Trace::Util;
sub trace_begin
{
# optional
}
sub trace_end
{
# optional
}
sub sched::sched_switch
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$prev_comm, $prev_pid, $prev_prio, $prev_state,
$next_comm, $next_pid, $next_prio) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
printf("prev_comm=%s, prev_pid=%d, prev_prio=%d, prev_state=%s, ".
"next_comm=%s, next_pid=%d, next_prio=%d\n",
$prev_comm, $prev_pid, $prev_prio,
flag_str("sched::sched_switch", "prev_state", $prev_state),
$next_comm, $next_pid, $next_prio);
}
sub irq::softirq_exit
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$vec) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
printf("vec=%s\n",
symbol_str("irq::softirq_exit", "vec", $vec));
}
sub irq::softirq_entry
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$vec) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
printf("vec=%s\n",
symbol_str("irq::softirq_entry", "vec", $vec));
}
sub kmem::kfree
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$call_site, $ptr) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
printf("call_site=%u, ptr=%u\n",
$call_site, $ptr);
}
sub kmem::kmalloc
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm,
$call_site, $ptr, $bytes_req, $bytes_alloc,
$gfp_flags) = @_;
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm);
printf("call_site=%u, ptr=%u, bytes_req=%u, bytes_alloc=%u, ".
"gfp_flags=%s\n",
$call_site, $ptr, $bytes_req, $bytes_alloc,
flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
}
.
.
.
For each event in the trace, the generated event handlers will print
the event name along with all the fields for the event.
To run the script, run perf trace with the -p option:
root@tropicana:~# perf trace -s perf-trace.pl
The output should look something like this:
kmem::kmalloc 1 01041.022132636 11822 perf call_site=18446744071579892671, ptr=18446612134886444032, bytes_req=704, bytes_alloc=1024, gfp_flags=GFP_WAIT | GFP_IO | GFP_ZERO
kmem::kmalloc 1 01041.022157859 11822 perf call_site=18446744071579892671, ptr=18446612134886455296, bytes_req=704, bytes_alloc=1024, gfp_flags=GFP_WAIT | GFP_IO | GFP_ZERO
kmem::kmalloc 1 01041.022186965 11822 perf call_site=18446744071579892671, ptr=18446612134886447104, bytes_req=704, bytes_alloc=1024, gfp_flags=GFP_WAIT | GFP_IO | GFP_ZERO
kmem::kmalloc 1 01041.022219512 11822 perf call_site=18446744071579892671, ptr=18446612134886452224, bytes_req=704, bytes_alloc=1024, gfp_flags=GFP_WAIT | GFP_IO | GFP_ZERO
kmem::kmalloc 1 01041.022317930 11822 perf call_site=18446744072100923040, ptr=18446612135313073728, bytes_req=64, bytes_alloc=64, gfp_flags=GFP_WAIT | GFP_IO
sched::sched_switch 1 01041.022514835 11822 perf prev_comm=perf, prev_pid=11822, prev_prio=140, prev_state=D, next_comm=swapper, next_pid=0, next_prio=140
irq::softirq_entry 0 01041.024022805 0 swapper vec=TIMER
irq::softirq_exit 0 01041.024029784 0 swapper vec=TIMER
irq::softirq_entry 0 01041.024031978 0 swapper vec=SCHED
irq::softirq_exit 0 01041.024035551 0 swapper vec=SCHED
irq::softirq_entry 1 01041.024538754 0 init vec=TIMER
irq::softirq_exit 1 01041.024545467 0 init vec=TIMER
irq::softirq_entry 1 01041.025896765 0 init vec=BLOCK
irq::softirq_exit 1 01041.025944221 0 init vec=BLOCK
sched::sched_switch 1 01041.025958098 0 init prev_comm=swapper, prev_pid=0, prev_prio=140, prev_state=R, next_comm=perf, next_pid=11822, next_prio=140
kmem::kmalloc 1 01041.026372194 11822 perf call_site=18446744071580383712, ptr=18446612135006028448, bytes_req=32, bytes_alloc=32, gfp_flags=GFP_WAIT | GFP_IO
kmem::kmalloc 1 01041.026376141 11822 perf call_site=18446744071580382581, ptr=18446612134887800192, bytes_req=104, bytes_alloc=128, gfp_flags=GFP_WAIT | GFP_IO
kmem::kmalloc 1 01041.026400928 11822 perf call_site=18446744071580383440, ptr=18446612134887923712, bytes_req=4096, bytes_alloc=4096, gfp_flags=GFP_WAIT | GFP_IO
kmem::kfree 1 01041.026581992 11822 perf call_site=18446744071580379757, ptr=18446612134887923712
kmem::kfree 1 01041.026586236 11822 perf call_site=18446744071580379765, ptr=18446612134887800192
kmem::kfree 1 01041.026588755 11822 perf call_site=18446744071580379904, ptr=18446612135006028448
kmem::kmalloc 1 01041.026654934 11822 perf call_site=18446744071580626944, ptr=18446612135006028448, bytes_req=24, bytes_alloc=32, gfp_flags=GFP_WAIT | GFP_IO | GFP_ZERO
kmem::kmalloc 1 01041.026657946 11822 perf call_site=18446744071580382581, ptr=18446612134887800192, bytes_req=104, bytes_alloc=128, gfp_flags=GFP_WAIT | GFP_IO
kmem::kmalloc 1 01041.026672236 11822 perf call_site=18446744071580383440, ptr=18446612135312744448, bytes_req=4096, bytes_alloc=4096, gfp_flags=GFP_WAIT | GFP_IO
kmem::kfree 1 01041.026889195 11822 perf call_site=18446744071580379823, ptr=18446612135006028448
kmem::kfree 1 01041.026892212 11822 perf call_site=18446744071580379757, ptr=18446612135312744448
.
.
.
Notice the gfp_flags and vec fields in the previous trace snippet.
Not only does the generated script display the normal string and
numeric fields, but it also automatically figures out that certain
fields, though numeric, should be interpreted as flags or symbols
instead, and generates the code to do that (using the flag and
symbolic enumerations defined in the event's format file).
Running the autogenerated script and displaying the printed events is
only marginally useful; at the least it can be used to see what's
there and verify that things basically work.
One of the other things that might be marginally useful might be to
remove all the handlers from the generated script and replace it with
a single handler for the 'unhandled_trace' event which is available to
every script. Here's a complete script for doing that:
# perf trace event handlers, generated by perf trace -g perl
# Licensed under the terms of the GNU GPL License version 2
# The common_* event handler fields are the most useful fields common to
# all events. They don't necessarily correspond to the 'common_*' fields
# in the format files. Those fields not available as handler params can
# be retrieved using Perl functions of the form common_*($context).
# See Context.pm for the list of available functions.
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
use lib "./Perf-Trace-Util/lib";
use Perf::Trace::Core;
use Perf::Trace::Context;
use Perf::Trace::Util;
my %unhandled;
sub trace_end
{
print_unhandled();
}
sub trace_unhandled
{
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
$common_pid, $common_comm) = @_;
$unhandled{$event_name}++;
}
sub print_unhandled
{
if ((scalar keys %unhandled) == 0) {
return;
}
print "\nunhandled events:\n\n";
printf("%-40s %10s\n", "event", "count");
printf("%-40s %10s\n", "----------------------------------------",
"-----------");
foreach my $event_name (keys %unhandled) {
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
}
}
For every unhandled event (every event for this script, since we
removed all the real handlers), the total counts for each are hashed
by event name and printed out at the end of the trace (in the
'trace_end' handler, which can also be defined for each script.
Here's some example output for this script:
root@tropicana:~# perf trace -s perf-trace.pl
perf trace started with Perl script perf-trace.pl
unhandled events:
event count
---------------------------------------- -----------
kmem::kfree 973
irq::softirq_entry 458
kmem::kmalloc 971
sched::sched_switch 511
irq::softirq_exit 458
perf trace Perl script stopped
The main point of being able to script the trace stream, however, is
to use the power of the scripting language to do more useful analysis.
One simple example would be to display the total r/w activity for all
processes on the system:
root@tropicana:~# 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
^C[ perf record: Woken up 2 times to write data ]
[ perf record: Captured and wrote 0.748 MB perf.data (~32694 samples) ]
root@tropicana:~# perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl
perf trace started with Perl script /root/libexec/perf-core/scripts/perl/rw-by-pid.pl
read counts by pid:
pid comm # reads bytes_requested bytes_read
------ -------------------- ----------- ---------- ----------
12029 perf 1087 1106144 917550
5537 Xorg 83 1992 1992
11296 wterm 7 28672 64
5973 gnome-screensav 8 32768 64
5926 gnome-settings- 3 12288 32
failed reads by pid:
pid comm error # # errors
------ -------------------- ------ ----------
12029 perf 0 111
11296 wterm -11 5
5926 gnome-settings- -11 2
5973 gnome-screensav -11 6
write counts by pid:
pid comm # writes bytes_written
------ -------------------- ----------- ----------
12029 perf 2187 148952
11296 wterm 1 1
failed writes by pid:
pid comm error # # errors
------ -------------------- ------ ----------
perf trace Perl script stopped
The above output shows sorted tables of reads and write activity, and
also tracks counts of each different read/write return error seen by
each process.
We can use the results of a higher-level trace analysis like the one
above to create other scripts that drill down to get more detailed
output. For example, the above results show that perf itself was
responsible for a lot of reading and writing. To see more detail
about which files it's reading from/writing to, we can write and run
another script:
root@tropicana:~# perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_enter_write
^C[ perf record: Woken up 0 times to write data ]
[ perf record: Captured and wrote 33.299 MB perf.data (~1454834 samples) ]
root@tropicana:~# perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl
perf trace started with Perl script /root/libexec/perf-core/scripts/perl/rw-by-file.pl
file read counts for perf:
fd # reads bytes_requested
------ ---------- -----------
9 1710 1751040
6 1 32
7 1 32
5 1 32
file write counts for perf:
fd # writes bytes_written
------ ---------- -----------
3 391246 34916416
perf trace Perl script stopped
>From the above, we see that most of the reads are coming from fd 9 and
most of the writes are going to fd 3. At this point, we don't have
any further information about what those files actually are - to do
that we'd need to be able to get it from either the open() system call
tracepoint (preferably, but the filename isn't yet available from that
source) or from reading /proc during the trace.
Actually, we probably don't really event want to see the events from
perf itself, so should also have a way to filter out anything from
perf in the kernel.
Another simple example could be to use a script to track wakeup
latencies:
root@tropicana:~# perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup
^C[ perf record: Woken up 1 times to write data ]
[ perf record: Captured and wrote 0.365 MB perf.data (~15952 samples) ]
root@tropicana:~# perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl
perf trace started with Perl script /root/libexec/perf-core/scripts/perl/wakeup-latency.
wakeup_latency stats:
total_wakeups: 430
avg_wakeup_latency (ns): 12807
min_wakeup_latency (ns): 2745
max_wakeup_latency (ns): 154435
perf trace Perl script stopped
This script tracks the time differences between sched_wakeup and
sched_switch events and prints out the totals when the script is done.
One of the nice things about using trace data to do this kind of
analysis is that the individual trace records can be displayed at any
time, so for instance if one was interested in seeing exactly which
events caused the min an max latencies displayed in the output, the
individual events could be viewed by simply uncommenting the
auto-generated print statements.
Finally, here's another example that displays workqueue stats for a
trace run:
root@tropicana:~# perf record -c 1 -f -a -M -R -e workqueue:workqueue_creation -e workqueue:workqueue_destruction -e workqueue:workqueue_execution -e workqueue:workqueue_insertion
^C[ perf record: Woken up 1 times to write data ]
[ perf record: Captured and wrote 0.285 MB perf.data (~12470 samples) ]
root@tropicana:~# perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl
perf trace started with Perl script /root/libexec/perf-core/scripts/perl/workqueue-stats
workqueue work stats:
cpu ins exec name
--- --- ---- ----
0 4 4 kblockd/0
0 62 62 ata/0
0 90 91 events/0
0 58 58 kondemand/0
1 36 36 ata/1
1 1 0 events/0
1 42 42 events/1
1 18 18 kblockd/1
workqueue lifecycle stats:
cpu created destroyed name
--- ------- --------- ----
perf trace Perl script stopped
There's also a check-perf-trace.pl script in the
libexec/perf-core/scripts/perl directory that doesn't do anything
interesting but contains code that's meant to exercise all of the
functionality available for the Perl scripting support. Looking at
that, along with the other example scripts in that directory should
provide a basic starting point for writing scripts of your own.
Note also that the final patch adds a 'bin' directory containing some
shell scripts so you can run the above scripts without typing in the
full command lines. So, with libexec/perf-core/scripts/perl in your
path, you could for example run the perf record/report commands for
the workqueue-stats script like this:
root@tropicana:~# workqueue-stats-record
^C[ perf record: Woken up 1 times to write data ]
[ perf record: Captured and wrote 0.238 MB perf.data (~10389 samples) ]
root@tropicana:~# workqueue-stats-report
perf trace started with Perl script /root/libexec/perf-core/scripts/perl/workqueue-stats
workqueue work stats:
cpu ins exec name
--- --- ---- ----
0 2 2 kblockd/0
0 14 14 ata/0
0 2 2 events/0
0 5 5 kondemand/0
1 2 2 events/1
workqueue lifecycle stats:
cpu created destroyed name
--- ------- --------- ----
perf trace Perl script stopped
Thanks,
Tom
timestamp debugging code:
--- libexec/perf-core/scripts/perl/wakeup-latency.pl~ 2009-11-23 19:37:53.000000000 -0600
+++ libexec/perf-core/scripts/perl/wakeup-latency.pl 2009-11-23 19:45:56.000000000 -0600
@@ -32,6 +32,15 @@
$prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid,
$next_prio) = @_;
+ print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm);
+
+ printf("prev_comm=%s, prev_pid=%d, prev_prio=%d, prev_state=%s, ".
+ "next_comm=%s, next_pid=%d, next_prio=%d\n",
+ $prev_comm, $prev_pid, $prev_prio,
+ flag_str("sched::sched_switch", "prev_state", $prev_state),
+ $next_comm, $next_pid, $next_prio);
+
my $wakeup_ts = $last_wakeup{$common_cpu}{ts};
if ($wakeup_ts) {
my $switch_ts = nsecs($common_secs, $common_nsecs);
@@ -41,6 +50,7 @@
}
if ($wakeup_latency < $min_wakeup_latency) {
$min_wakeup_latency = $wakeup_latency;
+ print("min_wakeup_latency: $min_wakeup_latency\n");
}
$total_wakeup_latency += $wakeup_latency;
$total_wakeups++;
@@ -54,6 +64,14 @@
$common_pid, $common_comm,
$comm, $pid, $prio, $success, $target_cpu) = @_;
+ print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm);
+
+ printf("comm=%s, pid=%d, prio=%d, success=%d, ".
+ "target_cpu=%d\n",
+ $comm, $pid, $prio, $success,
+ $target_cpu);
+
$last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs);
}
@@ -101,3 +119,11 @@
$unhandled{$event_name}++;
}
+
+sub print_header
+{
+ my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
+
+ printf("%-20s %5u %05u.%09u %8u %-20s ",
+ $event_name, $cpu, $secs, $nsecs, $pid, $comm);
+}
Tom Zanussi (7):
perf trace: Add scripting ops
perf trace: Add flag/symbolic format_flags
perf trace: Add Perl scripting support
perf trace: Add perf trace scripting support modules for Perl
perf trace: Add interface to access perf data from Perl handlers
perf trace: Add Documentation for perf trace Perl support
perf trace: Add a scripts/perl/bin for perf trace shell scripts
tools/perf/Documentation/perf-trace-perl.txt | 219 +++++++
tools/perf/Documentation/perf-trace.txt | 11 +-
tools/perf/Makefile | 26 +-
tools/perf/builtin-trace.c | 250 ++++++++-
tools/perf/scripts/perl/Perf-Trace-Util/Context.c | 134 +++++
tools/perf/scripts/perl/Perf-Trace-Util/Context.xs | 41 ++
.../perf/scripts/perl/Perf-Trace-Util/Makefile.PL | 17 +
tools/perf/scripts/perl/Perf-Trace-Util/README | 59 ++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm | 55 ++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | 192 +++++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm | 88 +++
tools/perf/scripts/perl/Perf-Trace-Util/typemap | 1 +
.../perf/scripts/perl/bin/check-perf-trace-record | 7 +
.../perf/scripts/perl/bin/check-perf-trace-report | 5 +
tools/perf/scripts/perl/bin/rw-by-file-record | 2 +
tools/perf/scripts/perl/bin/rw-by-file-report | 5 +
tools/perf/scripts/perl/bin/rw-by-pid-record | 2 +
tools/perf/scripts/perl/bin/rw-by-pid-report | 5 +
tools/perf/scripts/perl/bin/wakeup-latency-record | 6 +
tools/perf/scripts/perl/bin/wakeup-latency-report | 5 +
tools/perf/scripts/perl/bin/workqueue-stats-record | 2 +
tools/perf/scripts/perl/bin/workqueue-stats-report | 6 +
tools/perf/scripts/perl/check-perf-trace.pl | 106 ++++
tools/perf/scripts/perl/rw-by-file.pl | 105 ++++
tools/perf/scripts/perl/rw-by-pid.pl | 170 ++++++
tools/perf/scripts/perl/wakeup-latency.pl | 103 ++++
tools/perf/scripts/perl/workqueue-stats.pl | 129 +++++
tools/perf/util/trace-event-parse.c | 41 ++-
tools/perf/util/trace-event-perl.c | 596 ++++++++++++++++++++
tools/perf/util/trace-event-perl.h | 51 ++
tools/perf/util/trace-event.h | 23 +
31 files changed, 2450 insertions(+), 12 deletions(-)
create mode 100644 tools/perf/Documentation/perf-trace-perl.txt
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/Context.c
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/README
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/typemap
create mode 100644 tools/perf/scripts/perl/bin/check-perf-trace-record
create mode 100644 tools/perf/scripts/perl/bin/check-perf-trace-report
create mode 100644 tools/perf/scripts/perl/bin/rw-by-file-record
create mode 100644 tools/perf/scripts/perl/bin/rw-by-file-report
create mode 100644 tools/perf/scripts/perl/bin/rw-by-pid-record
create mode 100644 tools/perf/scripts/perl/bin/rw-by-pid-report
create mode 100644 tools/perf/scripts/perl/bin/wakeup-latency-record
create mode 100644 tools/perf/scripts/perl/bin/wakeup-latency-report
create mode 100644 tools/perf/scripts/perl/bin/workqueue-stats-record
create mode 100644 tools/perf/scripts/perl/bin/workqueue-stats-report
create mode 100644 tools/perf/scripts/perl/check-perf-trace.pl
create mode 100644 tools/perf/scripts/perl/rw-by-file.pl
create mode 100644 tools/perf/scripts/perl/rw-by-pid.pl
create mode 100644 tools/perf/scripts/perl/wakeup-latency.pl
create mode 100644 tools/perf/scripts/perl/workqueue-stats.pl
create mode 100644 tools/perf/util/trace-event-perl.c
create mode 100644 tools/perf/util/trace-event-perl.h
Adds an interface, scripting_ops, that when implemented for a
particular scripting language enables built-in support for trace
stream processing using that language.
The interface is designed to enable full-fledged language interpreters
to be embedded inside the perf executable and thereby make the full
capabilities of the supported languages available for trace
processing.
See below for details on the interface.
This patch also adds a couple command-line options to 'perf trace':
The -s option option is used to specify the script to be run. Script
names that can be used with -s take the form:
[language spec:]scriptname[.ext]
Scripting languages register a set of 'language specs' that can be
used to specify scripts for the registered languages. The specs can
be used either as prefixes or extensions.
If [language spec:] is used, the script is taken as a script of the
matching language regardless of any extension it might have. If
[language spec:] is not used, [.ext] is used to look up the language
it corresponds to. Language specs are case insensitive.
e.g. Perl scripts can be specified in the following ways:
Perl:scriptname
pl:scriptname.py # extension ignored
PL:scriptname
scriptname.pl
scriptname.perl
The -g [language spec] option gives users an easy starting point for
writing scripts in the specified language. Scripting support for a
particular language can implement a generate_script() scripting op
that outputs an empty (or near-empty) set of handlers for all the
events contained in a given perf.data trace file - this option gives
users a direct way to access that.
Adding support for a scripting language
---------------------------------------
The main thing that needs to be done do add support for a new language
is to implement the scripting_ops interface:
It consists of the following four functions:
start_script()
stop_script()
process_event()
generate_script()
start_script() is called before any events are processed, and is meant
to give the scripting language support an opportunity to set things up
to receive events e.g. create and initialize an instance of a language
interpreter.
stop_script() is called after all events are processed, and is meant
to give the scripting language support an opportunity to clean up
e.g. destroy the interpreter instance, etc.
process_event() is called once for each event and takes as its main
parameter a pointer to the binary trace event record to be processed.
The implementation is responsible for picking out the binary fields
from the event record and sending them to the script handler function
associated with that event e.g. a function derived from the event name
it's meant to handle e.g. 'sched::sched_switch()'. The 'format'
information for trace events can be used to parse the binary data and
map it into a form usable by a given scripting language; see the Perl
implemention in subsequent patches for one possible way to leverage
the existing trace format parsing code in perf and map that info into
specific scripting language types.
generate_script() should generate a ready-to-run script for the
current set of events in the trace, preferably with bodies that print
out every field for each event. Again, look at the Perl
implementation for clues as to how that can be done. This is an
optional, but very useful op.
Support for a given language should also add a language-specific setup
function and call it from setup_scripting(). The language-specific
setup function associates the the scripting ops for that language with
one or more 'language specifiers' (see below) using
script_spec_register(). When a script name is specified on the
command line, the scripting ops associated with the specified language
are used to instantiate and use the appropriate interpreter to process
the trace stream.
In general, it should be relatively easy to add support for a new
language, especially if the language implementation supports an
interface allowing an interpreter to be 'embedded' inside another
program (in this case the containing program will be 'perf trace').
If so, it should be relatively straightforward to translate trace
events into invocations of user-defined script functions where
e.g. the function name corresponds to the event type and the function
parameters correspond to the event fields. The event and field type
information exported by the event tracing infrastructure (via the
event 'format' files) should be enough to parse and send any piece of
trace data to the user script. The easiest way to see how this can be
done would be to look at the Perl implementation contained in
perf/util/trace-event-perl.c/.h.
There are a couple of other things that aren't covered by the
scripting_ops or setup interface and are technically optional, but
should be implemented if possible. One of these is support for 'flag'
and 'symbolic' fields e.g. being able to use more human-readable
values such as 'GFP_KERNEL' or HI/BLOCK_IOPOLL/TASKLET in place of raw
flag values. See the Perl implementation to see how this can be done.
The other thing is support for 'calling back' into the perf executable
to access e.g. uncommon fields not passed by default into handler
functions, or any metadata the implementation might want to make
available to users via the language interface. Again, see the Perl
implementation for examples.
Signed-off-by: Tom Zanussi <[email protected]>
---
tools/perf/builtin-trace.c | 248 ++++++++++++++++++++++++++++++++++++++++-
tools/perf/util/trace-event.h | 11 ++
2 files changed, 257 insertions(+), 2 deletions(-)
diff --git a/tools/perf/builtin-trace.c b/tools/perf/builtin-trace.c
index d042d65..12122e2 100644
--- a/tools/perf/builtin-trace.c
+++ b/tools/perf/builtin-trace.c
@@ -13,6 +13,7 @@
#include "util/trace-event.h"
#include "util/data_map.h"
+#include "util/exec_cmd.h"
static char const *input_name = "perf.data";
@@ -25,6 +26,45 @@ static u64 sample_type;
static char *cwd;
static int cwdlen;
+static char const *script_name;
+static char const *generate_script_lang;
+
+static int default_start_script(const char *script __attribute((unused)))
+{
+ return 0;
+}
+
+static int default_stop_script(void)
+{
+ return 0;
+}
+
+static int default_generate_script(const char *outfile __attribute ((unused)))
+{
+ return 0;
+}
+
+static struct scripting_ops default_scripting_ops = {
+ .start_script = default_start_script,
+ .stop_script = default_stop_script,
+ .process_event = print_event,
+ .generate_script = default_generate_script,
+};
+
+static struct scripting_ops *scripting_ops;
+
+static void setup_scripting(void)
+{
+ /* make sure PERF_EXEC_PATH is set for scripts */
+ perf_set_argv_exec_path(perf_exec_path());
+
+ scripting_ops = &default_scripting_ops;
+}
+
+static int cleanup_scripting(void)
+{
+ return scripting_ops->stop_script();
+}
static int
process_comm_event(event_t *event, unsigned long offset, unsigned long head)
@@ -99,7 +139,8 @@ process_sample_event(event_t *event, unsigned long offset, unsigned long head)
* field, although it should be the same than this perf
* event pid
*/
- print_event(cpu, raw->data, raw->size, timestamp, thread->comm);
+ scripting_ops->process_event(cpu, raw->data, raw->size,
+ timestamp, thread->comm);
}
total += period;
@@ -134,6 +175,154 @@ static int __cmd_trace(void)
return mmap_dispatch_perf_file(&header, input_name, 0, 0, &cwdlen, &cwd);
}
+struct script_spec {
+ struct list_head node;
+ struct scripting_ops *ops;
+ char spec[0];
+};
+
+LIST_HEAD(script_specs);
+
+static struct script_spec *script_spec__new(const char *spec,
+ struct scripting_ops *ops)
+{
+ struct script_spec *s = malloc(sizeof(*s) + strlen(spec) + 1);
+
+ if (s != NULL) {
+ strcpy(s->spec, spec);
+ s->ops = ops;
+ }
+
+ return s;
+}
+
+static void script_spec__delete(struct script_spec *s)
+{
+ free(s->spec);
+ free(s);
+}
+
+static void script_spec__add(struct script_spec *s)
+{
+ list_add_tail(&s->node, &script_specs);
+}
+
+static struct script_spec *script_spec__find(const char *spec)
+{
+ struct script_spec *s;
+
+ list_for_each_entry(s, &script_specs, node)
+ if (strcasecmp(s->spec, spec) == 0)
+ return s;
+ return NULL;
+}
+
+static struct script_spec *script_spec__findnew(const char *spec,
+ struct scripting_ops *ops)
+{
+ struct script_spec *s = script_spec__find(spec);
+
+ if (s)
+ return s;
+
+ s = script_spec__new(spec, ops);
+ if (!s)
+ goto out_delete_spec;
+
+ script_spec__add(s);
+
+ return s;
+
+out_delete_spec:
+ script_spec__delete(s);
+
+ return NULL;
+}
+
+int script_spec_register(const char *spec, struct scripting_ops *ops)
+{
+ struct script_spec *s;
+
+ s = script_spec__find(spec);
+ if (s)
+ return -1;
+
+ s = script_spec__findnew(spec, ops);
+ if (!s)
+ return -1;
+
+ return 0;
+}
+
+static struct scripting_ops *script_spec__lookup(const char *spec)
+{
+ struct script_spec *s = script_spec__find(spec);
+ if (!s)
+ return NULL;
+
+ return s->ops;
+}
+
+static void list_available_languages(void)
+{
+ struct script_spec *s;
+
+ fprintf(stderr, "\n");
+ fprintf(stderr, "Scripting language extensions (used in "
+ "perf trace -s [spec:]script.[spec]):\n\n");
+
+ list_for_each_entry(s, &script_specs, node)
+ fprintf(stderr, " %-42s [%s]\n", s->spec, s->ops->name);
+
+ fprintf(stderr, "\n");
+}
+
+static int parse_scriptname(const struct option *opt __used,
+ const char *str, int unset __used)
+{
+ char spec[PATH_MAX];
+ const char *script, *ext;
+ int len;
+
+ if (strcmp(str, "list") == 0) {
+ list_available_languages();
+ return 0;
+ }
+
+ script = strchr(str, ':');
+ if (script) {
+ len = script - str;
+ if (len >= PATH_MAX) {
+ fprintf(stderr, "invalid language specifier");
+ return -1;
+ }
+ strncpy(spec, str, len);
+ spec[len] = '\0';
+ scripting_ops = script_spec__lookup(spec);
+ if (!scripting_ops) {
+ fprintf(stderr, "invalid language specifier");
+ return -1;
+ }
+ script++;
+ } else {
+ script = str;
+ ext = strchr(script, '.');
+ if (!ext) {
+ fprintf(stderr, "invalid script extension");
+ return -1;
+ }
+ scripting_ops = script_spec__lookup(++ext);
+ if (!scripting_ops) {
+ fprintf(stderr, "invalid script extension");
+ return -1;
+ }
+ }
+
+ script_name = strdup(script);
+
+ return 0;
+}
+
static const char * const annotate_usage[] = {
"perf trace [<options>] <command>",
NULL
@@ -146,13 +335,23 @@ static const struct option options[] = {
"be more verbose (show symbol address, etc)"),
OPT_BOOLEAN('l', "latency", &latency_format,
"show latency attributes (irqs/preemption disabled, etc)"),
+ OPT_CALLBACK('s', "script", NULL, "name",
+ "script file name (lang:script name, script name, or *)",
+ parse_scriptname),
+ OPT_STRING('g', "gen-script", &generate_script_lang, "lang",
+ "generate perf-trace.xx script in specified language"),
+
OPT_END()
};
int cmd_trace(int argc, const char **argv, const char *prefix __used)
{
+ int err;
+
symbol__init(0);
+ setup_scripting();
+
argc = parse_options(argc, argv, options, annotate_usage, 0);
if (argc) {
/*
@@ -165,5 +364,50 @@ int cmd_trace(int argc, const char **argv, const char *prefix __used)
setup_pager();
- return __cmd_trace();
+ if (generate_script_lang) {
+ struct stat perf_stat;
+
+ int input = open(input_name, O_RDONLY);
+ if (input < 0) {
+ perror("failed to open file");
+ exit(-1);
+ }
+
+ err = fstat(input, &perf_stat);
+ if (err < 0) {
+ perror("failed to stat file");
+ exit(-1);
+ }
+
+ if (!perf_stat.st_size) {
+ fprintf(stderr, "zero-sized file, nothing to do!\n");
+ exit(0);
+ }
+
+ scripting_ops = script_spec__lookup(generate_script_lang);
+ if (!scripting_ops) {
+ fprintf(stderr, "invalid language specifier");
+ return -1;
+ }
+
+ header = perf_header__new();
+ if (header == NULL)
+ return -1;
+
+ perf_header__read(header, input);
+ err = scripting_ops->generate_script("perf-trace");
+ goto out;
+ }
+
+ if (script_name) {
+ err = scripting_ops->start_script(script_name);
+ if (err)
+ goto out;
+ }
+
+ err = __cmd_trace();
+
+ cleanup_scripting();
+out:
+ return err;
}
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index dd51c68..e7aaf00 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -259,4 +259,15 @@ enum trace_flag_type {
TRACE_FLAG_SOFTIRQ = 0x10,
};
+struct scripting_ops {
+ const char *name;
+ int (*start_script) (const char *);
+ int (*stop_script) (void);
+ void (*process_event) (int cpu, void *data, int size,
+ unsigned long long nsecs, char *comm);
+ int (*generate_script) (const char *outfile);
+};
+
+int script_spec_register(const char *spec, struct scripting_ops *ops);
+
#endif /* __PERF_TRACE_EVENTS_H */
--
1.6.4.GIT
It's useful to know whether a field is a flag or symbolic field for
e.g. when generating scripts - it allows us to translate those fields
specially rather than literally as plain numeric values.
Signed-off-by: Tom Zanussi <[email protected]>
---
tools/perf/util/trace-event-parse.c | 17 +++++++++++++++++
tools/perf/util/trace-event.h | 2 ++
2 files changed, 19 insertions(+), 0 deletions(-)
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index eae5605..b2aa520 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -48,6 +48,11 @@ static unsigned long long input_buf_siz;
static int cpus;
static int long_size;
+static int is_flag_field;
+static int is_symbolic_field;
+
+static struct format_field *
+find_any_field(struct event *event, const char *name);
static void init_input_buf(char *buf, unsigned long long size)
{
@@ -1300,6 +1305,16 @@ process_entry(struct event *event __unused, struct print_arg *arg,
arg->type = PRINT_FIELD;
arg->field.name = field;
+ if (is_flag_field) {
+ arg->field.field = find_any_field(event, arg->field.name);
+ arg->field.field->flags |= FIELD_IS_FLAG;
+ is_flag_field = 0;
+ } else if (is_symbolic_field) {
+ arg->field.field = find_any_field(event, arg->field.name);
+ arg->field.field->flags |= FIELD_IS_SYMBOLIC;
+ is_symbolic_field = 0;
+ }
+
type = read_token(&token);
*tok = token;
@@ -1667,9 +1682,11 @@ process_arg_token(struct event *event, struct print_arg *arg,
type = process_entry(event, arg, &token);
} else if (strcmp(token, "__print_flags") == 0) {
free_token(token);
+ is_flag_field = 1;
type = process_flags(event, arg, &token);
} else if (strcmp(token, "__print_symbolic") == 0) {
free_token(token);
+ is_symbolic_field = 1;
type = process_symbols(event, arg, &token);
} else if (strcmp(token, "__get_str") == 0) {
free_token(token);
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index e7aaf00..aeb9157 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -29,6 +29,8 @@ enum format_flags {
FIELD_IS_SIGNED = 4,
FIELD_IS_STRING = 8,
FIELD_IS_DYNAMIC = 16,
+ FIELD_IS_FLAG = 32,
+ FIELD_IS_SYMBOLIC = 64,
};
struct format_field {
--
1.6.4.GIT
Implement trace_scripting_ops to make Perl a supported perf trace
scripting language.
Additionally adds code that allows Perl trace scripts to access the
'flag' and 'symbolic' (__print_flags(), __print_symbolic()) field
information parsed from the trace format files.
Also adds the Perl implementation of the generate_script()
trace_scripting_op, which creates a ready-to-run perf trace Perl
script based on existing trace data. Scripts generated by this
implementation print out all the fields for each event mentioned in
perf.data (and will detect and generate the proper scripting code for
'flag' and 'symbolic' fields), and will additionally generate handlers
for the special 'trace_unhandled', 'trace_begin' and 'trace_end'
handlers. Script authors can simply remove the printing code to
implement their own custom event handling.
Signed-off-by: Tom Zanussi <[email protected]>
---
tools/perf/Makefile | 13 +
tools/perf/builtin-trace.c | 2 +
tools/perf/util/trace-event-parse.c | 18 +-
tools/perf/util/trace-event-perl.c | 552 +++++++++++++++++++++++++++++++++++
tools/perf/util/trace-event-perl.h | 42 +++
tools/perf/util/trace-event.h | 7 +
6 files changed, 629 insertions(+), 5 deletions(-)
create mode 100644 tools/perf/util/trace-event-perl.c
create mode 100644 tools/perf/util/trace-event-perl.h
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index dd30158..ceceafe 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -421,6 +421,7 @@ LIB_OBJS += util/thread.o
LIB_OBJS += util/trace-event-parse.o
LIB_OBJS += util/trace-event-read.o
LIB_OBJS += util/trace-event-info.o
+LIB_OBJS += util/trace-event-perl.o
LIB_OBJS += util/svghelper.o
LIB_OBJS += util/sort.o
LIB_OBJS += util/hist.o
@@ -503,6 +504,15 @@ else
LIB_OBJS += util/probe-finder.o
endif
+PERL_EMBED_LDOPTS = `perl -MExtUtils::Embed -e ldopts`
+PERL_EMBED_CCOPTS = `perl -MExtUtils::Embed -e ccopts`
+
+ifneq ($(shell sh -c "(echo '\#include <EXTERN.h>'; echo '\#include <perl.h>'; echo 'int main(void) { perl_alloc(); return 0; }') | $(CC) -x c - $(PERL_EMBED_CCOPTS) -o /dev/null $(PERL_EMBED_LDOPTS) > /dev/null 2>&1 && echo y"), y)
+ BASIC_CFLAGS += -DNO_LIBPERL
+else
+ ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
+endif
+
ifdef NO_DEMANGLE
BASIC_CFLAGS += -DNO_DEMANGLE
else
@@ -874,6 +884,9 @@ util/hweight.o: ../../lib/hweight.c PERF-CFLAGS
util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
$(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $<
+util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
+ $(QUIET_CC)$(CC) -o util/trace-event-perl.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter $<
+
perf-%$X: %.o $(PERFLIBS)
$(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
diff --git a/tools/perf/builtin-trace.c b/tools/perf/builtin-trace.c
index 12122e2..af03ac6 100644
--- a/tools/perf/builtin-trace.c
+++ b/tools/perf/builtin-trace.c
@@ -58,6 +58,8 @@ static void setup_scripting(void)
/* make sure PERF_EXEC_PATH is set for scripts */
perf_set_argv_exec_path(perf_exec_path());
+ setup_perl_scripting();
+
scripting_ops = &default_scripting_ops;
}
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index b2aa520..600d52e 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -1887,7 +1887,7 @@ find_any_field(struct event *event, const char *name)
return find_field(event, name);
}
-static unsigned long long read_size(void *ptr, int size)
+unsigned long long read_size(void *ptr, int size)
{
switch (size) {
case 1:
@@ -1972,7 +1972,7 @@ int trace_parse_common_type(void *data)
"common_type");
}
-static int parse_common_pid(void *data)
+int trace_parse_common_pid(void *data)
{
static int pid_offset;
static int pid_size;
@@ -2024,6 +2024,14 @@ struct event *trace_find_event(int id)
return event;
}
+struct event *trace_find_next_event(struct event *event)
+{
+ if (!event)
+ return event_list;
+
+ return event->next;
+}
+
static unsigned long long eval_num_arg(void *data, int size,
struct event *event, struct print_arg *arg)
{
@@ -2163,7 +2171,7 @@ static const struct flag flags[] = {
{ "HRTIMER_RESTART", 1 },
};
-static unsigned long long eval_flag(const char *flag)
+unsigned long long eval_flag(const char *flag)
{
int i;
@@ -2693,7 +2701,7 @@ get_return_for_leaf(int cpu, int cur_pid, unsigned long long cur_func,
if (!(event->flags & EVENT_FL_ISFUNCRET))
return NULL;
- pid = parse_common_pid(next->data);
+ pid = trace_parse_common_pid(next->data);
field = find_field(event, "func");
if (!field)
die("function return does not have field func");
@@ -2979,7 +2987,7 @@ void print_event(int cpu, void *data, int size, unsigned long long nsecs,
return;
}
- pid = parse_common_pid(data);
+ pid = trace_parse_common_pid(data);
if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET))
return pretty_print_func_graph(data, size, event, cpu,
diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c
new file mode 100644
index 0000000..c56b08d
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.c
@@ -0,0 +1,552 @@
+/*
+ * trace-event-perl. Feed perf trace events to an embedded Perl interpreter.
+ *
+ * Copyright (C) 2009 Tom Zanussi <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <errno.h>
+
+#include "../perf.h"
+#include "util.h"
+#include "trace-event.h"
+#include "trace-event-perl.h"
+
+INTERP my_perl;
+
+#define FTRACE_MAX_EVENT \
+ ((1 << (sizeof(unsigned short) * 8)) - 1)
+
+struct event *events[FTRACE_MAX_EVENT];
+
+static struct scripting_context *scripting_context;
+
+static char *cur_field_name;
+static int zero_flag_atom;
+
+static void define_symbolic_value(const char *ev_name,
+ const char *field_name,
+ const char *field_value,
+ const char *field_str)
+{
+ unsigned long long value;
+ dSP;
+
+ value = eval_flag(field_value);
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+ XPUSHs(sv_2mortal(newSVuv(value)));
+ XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_symbolic_value", 0))
+ call_pv("main::define_symbolic_value", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_symbolic_values(struct print_flag_sym *field,
+ const char *ev_name,
+ const char *field_name)
+{
+ define_symbolic_value(ev_name, field_name, field->value, field->str);
+ if (field->next)
+ define_symbolic_values(field->next, ev_name, field_name);
+}
+
+static void define_symbolic_field(const char *ev_name,
+ const char *field_name)
+{
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_symbolic_field", 0))
+ call_pv("main::define_symbolic_field", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_flag_value(const char *ev_name,
+ const char *field_name,
+ const char *field_value,
+ const char *field_str)
+{
+ unsigned long long value;
+ dSP;
+
+ value = eval_flag(field_value);
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+ XPUSHs(sv_2mortal(newSVuv(value)));
+ XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_flag_value", 0))
+ call_pv("main::define_flag_value", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_flag_values(struct print_flag_sym *field,
+ const char *ev_name,
+ const char *field_name)
+{
+ define_flag_value(ev_name, field_name, field->value, field->str);
+ if (field->next)
+ define_flag_values(field->next, ev_name, field_name);
+}
+
+static void define_flag_field(const char *ev_name,
+ const char *field_name,
+ const char *delim)
+{
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(delim, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_flag_field", 0))
+ call_pv("main::define_flag_field", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_event_symbols(struct event *event,
+ const char *ev_name,
+ struct print_arg *args)
+{
+ switch (args->type) {
+ case PRINT_NULL:
+ break;
+ case PRINT_ATOM:
+ define_flag_value(ev_name, cur_field_name, "0",
+ args->atom.atom);
+ zero_flag_atom = 0;
+ break;
+ case PRINT_FIELD:
+ if (cur_field_name)
+ free(cur_field_name);
+ cur_field_name = strdup(args->field.name);
+ break;
+ case PRINT_FLAGS:
+ define_event_symbols(event, ev_name, args->flags.field);
+ define_flag_field(ev_name, cur_field_name, args->flags.delim);
+ define_flag_values(args->flags.flags, ev_name, cur_field_name);
+ break;
+ case PRINT_SYMBOL:
+ define_event_symbols(event, ev_name, args->symbol.field);
+ define_symbolic_field(ev_name, cur_field_name);
+ define_symbolic_values(args->symbol.symbols, ev_name,
+ cur_field_name);
+ break;
+ case PRINT_STRING:
+ break;
+ case PRINT_TYPE:
+ define_event_symbols(event, ev_name, args->typecast.item);
+ break;
+ case PRINT_OP:
+ if (strcmp(args->op.op, ":") == 0)
+ zero_flag_atom = 1;
+ define_event_symbols(event, ev_name, args->op.left);
+ define_event_symbols(event, ev_name, args->op.right);
+ break;
+ default:
+ /* we should warn... */
+ return;
+ }
+
+ if (args->next)
+ define_event_symbols(event, ev_name, args->next);
+}
+
+static inline struct event *find_cache_event(int type)
+{
+ static char ev_name[256];
+ struct event *event;
+
+ if (events[type])
+ return events[type];
+
+ events[type] = event = trace_find_event(type);
+ if (!event)
+ return NULL;
+
+ sprintf(ev_name, "%s::%s", event->system, event->name);
+
+ define_event_symbols(event, ev_name, event->print_fmt.args);
+
+ return event;
+}
+
+static void perl_process_event(int cpu, void *data,
+ int size __attribute((unused)),
+ unsigned long long nsecs, char *comm)
+{
+ struct format_field *field;
+ static char handler[256];
+ unsigned long long val;
+ unsigned long s, ns;
+ struct event *event;
+ int type;
+ int pid;
+
+ dSP;
+
+ type = trace_parse_common_type(data);
+
+ event = find_cache_event(type);
+ if (!event)
+ die("ug! no event found for type %d", type);
+
+ pid = trace_parse_common_pid(data);
+
+ sprintf(handler, "%s::%s", event->system, event->name);
+
+ s = nsecs / NSECS_PER_SEC;
+ ns = nsecs - s * NSECS_PER_SEC;
+
+ scripting_context->event_data = data;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(handler, 0)));
+ XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
+ XPUSHs(sv_2mortal(newSVuv(cpu)));
+ XPUSHs(sv_2mortal(newSVuv(s)));
+ XPUSHs(sv_2mortal(newSVuv(ns)));
+ XPUSHs(sv_2mortal(newSViv(pid)));
+ XPUSHs(sv_2mortal(newSVpv(comm, 0)));
+
+ /* common fields other than pid can be accessed via xsub fns */
+
+ for (field = event->format.fields; field; field = field->next) {
+ if (field->flags & FIELD_IS_STRING) {
+ int offset;
+ if (field->flags & FIELD_IS_DYNAMIC) {
+ offset = *(int *)(data + field->offset);
+ offset &= 0xffff;
+ } else
+ offset = field->offset;
+ XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
+ } else { /* FIELD_IS_NUMERIC */
+ val = read_size(data + field->offset, field->size);
+ if (field->flags & FIELD_IS_SIGNED) {
+ XPUSHs(sv_2mortal(newSViv(val)));
+ } else {
+ XPUSHs(sv_2mortal(newSVuv(val)));
+ }
+ }
+ }
+
+ PUTBACK;
+ if (get_cv(handler, 0))
+ call_pv(handler, G_SCALAR);
+ else if (get_cv("main::trace_unhandled", 0)) {
+ XPUSHs(sv_2mortal(newSVpv(handler, 0)));
+ XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
+ XPUSHs(sv_2mortal(newSVuv(cpu)));
+ XPUSHs(sv_2mortal(newSVuv(nsecs)));
+ XPUSHs(sv_2mortal(newSViv(pid)));
+ XPUSHs(sv_2mortal(newSVpv(comm, 0)));
+ call_pv("main::trace_unhandled", G_SCALAR);
+ }
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void run_start_sub(void)
+{
+ dSP; /* access to Perl stack */
+ PUSHMARK(SP);
+
+ if (get_cv("main::trace_begin", 0))
+ call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
+}
+
+/*
+ * Start trace script
+ */
+static int perl_start_script(const char *script)
+{
+ const char *command_line[2] = { "", NULL };
+
+ command_line[1] = script;
+
+ my_perl = perl_alloc();
+ perl_construct(my_perl);
+
+ if (perl_parse(my_perl, NULL, 2, (char **)command_line, (char **)NULL))
+ return -1;
+
+ perl_run(my_perl);
+ if (SvTRUE(ERRSV))
+ return -1;
+
+ run_start_sub();
+
+ fprintf(stderr, "perf trace started with Perl script %s\n\n", script);
+
+ return 0;
+}
+
+/*
+ * Stop trace script
+ */
+static int perl_stop_script(void)
+{
+ dSP; /* access to Perl stack */
+ PUSHMARK(SP);
+
+ if (get_cv("main::trace_end", 0))
+ call_pv("main::trace_end", G_DISCARD | G_NOARGS);
+
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+
+ fprintf(stderr, "\nperf trace Perl script stopped\n");
+
+ return 0;
+}
+
+static int perl_generate_script(const char *outfile)
+{
+ struct event *event = NULL;
+ struct format_field *f;
+ char fname[PATH_MAX];
+ int not_first, count;
+ FILE *ofp;
+
+ sprintf(fname, "%s.pl", outfile);
+ ofp = fopen(fname, "w");
+ if (ofp == NULL) {
+ fprintf(stderr, "couldn't open %s\n", fname);
+ return -1;
+ }
+
+ fprintf(ofp, "# perf trace event handlers, "
+ "generated by perf trace -g perl\n");
+
+ fprintf(ofp, "# Licensed under the terms of the GNU GPL"
+ " License version 2\n\n");
+
+ fprintf(ofp, "# The common_* event handler fields are the most useful "
+ "fields common to\n");
+
+ fprintf(ofp, "# all events. They don't necessarily correspond to "
+ "the 'common_*' fields\n");
+
+ fprintf(ofp, "# in the format files. Those fields not available as "
+ "handler params can\n");
+
+ fprintf(ofp, "# be retrieved using Perl functions of the form "
+ "common_*($context).\n");
+
+ fprintf(ofp, "# See Context.pm for the list of available "
+ "functions.\n\n");
+
+ fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
+ "Perf-Trace-Util/lib\";\n");
+
+ fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
+ fprintf(ofp, "use Perf::Trace::Core;\n");
+ fprintf(ofp, "use Perf::Trace::Context;\n");
+ fprintf(ofp, "use Perf::Trace::Util;\n\n");
+
+ fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
+ fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n");
+
+ while ((event = trace_find_next_event(event))) {
+ fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
+ fprintf(ofp, "\tmy (");
+
+ fprintf(ofp, "$event_name, ");
+ fprintf(ofp, "$context, ");
+ fprintf(ofp, "$common_cpu, ");
+ fprintf(ofp, "$common_secs, ");
+ fprintf(ofp, "$common_nsecs,\n");
+ fprintf(ofp, "\t $common_pid, ");
+ fprintf(ofp, "$common_comm,\n\t ");
+
+ not_first = 0;
+ count = 0;
+
+ for (f = event->format.fields; f; f = f->next) {
+ if (not_first++)
+ fprintf(ofp, ", ");
+ if (++count % 5 == 0)
+ fprintf(ofp, "\n\t ");
+
+ fprintf(ofp, "$%s", f->name);
+ }
+ fprintf(ofp, ") = @_;\n\n");
+
+ fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
+ "$common_secs, $common_nsecs,\n\t "
+ "$common_pid, $common_comm);\n\n");
+
+ fprintf(ofp, "\tprintf(\"");
+
+ not_first = 0;
+ count = 0;
+
+ for (f = event->format.fields; f; f = f->next) {
+ if (not_first++)
+ fprintf(ofp, ", ");
+ if (count && count % 4 == 0) {
+ fprintf(ofp, "\".\n\t \"");
+ }
+ count++;
+
+ fprintf(ofp, "%s=", f->name);
+ if (f->flags & FIELD_IS_STRING ||
+ f->flags & FIELD_IS_FLAG ||
+ f->flags & FIELD_IS_SYMBOLIC)
+ fprintf(ofp, "%%s");
+ else if (f->flags & FIELD_IS_SIGNED)
+ fprintf(ofp, "%%d");
+ else
+ fprintf(ofp, "%%u");
+ }
+
+ fprintf(ofp, "\\n\",\n\t ");
+
+ not_first = 0;
+ count = 0;
+
+ for (f = event->format.fields; f; f = f->next) {
+ if (not_first++)
+ fprintf(ofp, ", ");
+
+ if (++count % 5 == 0)
+ fprintf(ofp, "\n\t ");
+
+ if (f->flags & FIELD_IS_FLAG) {
+ if ((count - 1) % 5 != 0) {
+ fprintf(ofp, "\n\t ");
+ count = 4;
+ }
+ fprintf(ofp, "flag_str(\"");
+ fprintf(ofp, "%s::%s\", ", event->system,
+ event->name);
+ fprintf(ofp, "\"%s\", $%s)", f->name,
+ f->name);
+ } else if (f->flags & FIELD_IS_SYMBOLIC) {
+ if ((count - 1) % 5 != 0) {
+ fprintf(ofp, "\n\t ");
+ count = 4;
+ }
+ fprintf(ofp, "symbol_str(\"");
+ fprintf(ofp, "%s::%s\", ", event->system,
+ event->name);
+ fprintf(ofp, "\"%s\", $%s)", f->name,
+ f->name);
+ } else
+ fprintf(ofp, "$%s", f->name);
+ }
+
+ fprintf(ofp, ");\n");
+ fprintf(ofp, "}\n\n");
+ }
+
+ fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
+ "$common_cpu, $common_secs, $common_nsecs,\n\t "
+ "$common_pid, $common_comm) = @_;\n\n");
+
+ fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
+ "$common_secs, $common_nsecs,\n\t $common_pid, "
+ "$common_comm);\n}\n\n");
+
+ fprintf(ofp, "sub print_header\n{\n"
+ "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
+ "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t "
+ "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}");
+
+ fclose(ofp);
+
+ fprintf(stderr, "generated Perl script: %s\n", fname);
+
+ return 0;
+}
+
+struct scripting_ops perl_scripting_ops = {
+ .name = "Perl",
+ .start_script = perl_start_script,
+ .stop_script = perl_stop_script,
+ .process_event = perl_process_event,
+ .generate_script = perl_generate_script,
+};
+
+#ifdef NO_LIBPERL
+void setup_perl_scripting(void)
+{
+ fprintf(stderr, "Perl scripting not supported."
+ " Install libperl-dev[el] and rebuild perf to get it.\n");
+}
+#else
+void setup_perl_scripting(void)
+{
+ int err;
+ err = script_spec_register("Perl", &perl_scripting_ops);
+ if (err)
+ die("error registering Perl script extension");
+
+ err = script_spec_register("pl", &perl_scripting_ops);
+ if (err)
+ die("error registering pl script extension");
+
+ scripting_context = malloc(sizeof(struct scripting_context));
+}
+#endif
diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h
new file mode 100644
index 0000000..6c94fa9
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.h
@@ -0,0 +1,42 @@
+#ifndef __PERF_TRACE_EVENT_PERL_H
+#define __PERF_TRACE_EVENT_PERL_H
+#ifdef NO_LIBPERL
+typedef int INTERP;
+#define dSP
+#define ENTER
+#define SAVETMPS
+#define PUTBACK
+#define SPAGAIN
+#define FREETMPS
+#define LEAVE
+#define SP
+#define ERRSV
+#define G_SCALAR (0)
+#define G_DISCARD (0)
+#define G_NOARGS (0)
+#define PUSHMARK(a)
+#define SvTRUE(a) (0)
+#define XPUSHs(s)
+#define sv_2mortal(a)
+#define newSVpv(a,b)
+#define newSVuv(a)
+#define newSViv(a)
+#define get_cv(a,b) (0)
+#define call_pv(a,b) (0)
+#define perl_alloc() (0)
+#define perl_construct(a) (0)
+#define perl_parse(a,b,c,d,e) (0)
+#define perl_run(a) (0)
+#define perl_destruct(a) (0)
+#define perl_free(a) (0)
+#else
+#include <EXTERN.h>
+#include <perl.h>
+typedef PerlInterpreter * INTERP;
+#endif
+
+struct scripting_context {
+ void *event_data;
+};
+
+#endif /* __PERF_TRACE_EVENT_PERL_H */
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index aeb9157..b1e58d3 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -245,10 +245,14 @@ extern int latency_format;
int parse_header_page(char *buf, unsigned long size);
int trace_parse_common_type(void *data);
+int trace_parse_common_pid(void *data);
struct event *trace_find_event(int id);
+struct event *trace_find_next_event(struct event *event);
+unsigned long long read_size(void *ptr, int size);
unsigned long long
raw_field_value(struct event *event, const char *name, void *data);
void *raw_field_ptr(struct event *event, const char *name, void *data);
+unsigned long long eval_flag(const char *flag);
int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events);
@@ -272,4 +276,7 @@ struct scripting_ops {
int script_spec_register(const char *spec, struct scripting_ops *ops);
+extern struct scripting_ops perl_scripting_ops;
+void setup_perl_scripting(void);
+
#endif /* __PERF_TRACE_EVENTS_H */
--
1.6.4.GIT
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 <[email protected]>
---
tools/perf/Makefile | 7 +
.../perf/scripts/perl/Perf-Trace-Util/Makefile.PL | 12 ++
tools/perf/scripts/perl/Perf-Trace-Util/README | 35 ++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | 157 ++++++++++++++++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm | 88 ++++++++++
tools/perf/scripts/perl/rw-by-file.pl | 105 ++++++++++++
tools/perf/scripts/perl/rw-by-pid.pl | 170 ++++++++++++++++++++
tools/perf/scripts/perl/wakeup-latency.pl | 103 ++++++++++++
tools/perf/scripts/perl/workqueue-stats.pl | 129 +++++++++++++++
9 files changed, 806 insertions(+), 0 deletions(-)
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/README
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
create mode 100644 tools/perf/scripts/perl/rw-by-file.pl
create mode 100644 tools/perf/scripts/perl/rw-by-pid.pl
create mode 100644 tools/perf/scripts/perl/wakeup-latency.pl
create mode 100644 tools/perf/scripts/perl/workqueue-stats.pl
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index ceceafe..f536fff 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -994,6 +994,13 @@ export perfexec_instdir
install: all
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'
$(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)'
+ $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
+ $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
+ $(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
+ $(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl'
+ $(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
+ $(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
+ $(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
ifdef BUILT_INS
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
$(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 0000000..b0de02e
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
@@ -0,0 +1,12 @@
+use 5.010000;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'Perf::Trace::Util',
+ VERSION_FROM => 'lib/Perf/Trace/Util.pm', # finds $VERSION
+ PREREQ_PM => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/Perf/Trace/Util.pm', # retrieve abstract from module
+ AUTHOR => 'Tom Zanussi <[email protected]>') : ()),
+);
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 0000000..0a58378
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/README
@@ -0,0 +1,35 @@
+Perf-Trace-Util version 0.01
+============================
+
+This module contains utility functions for use with perf trace.
+
+INSTALLATION
+
+Building perf with perf trace Perl scripting should install this
+module in the right place.
+
+You should make sure libperl is installed first e.g. apt-get install
+libperl-dev.
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2009 by Tom Zanussi <[email protected]>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+
+
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 0000000..fd250fb
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm
@@ -0,0 +1,157 @@
+package Perf::Trace::Core;
+
+use 5.010000;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+define_flag_field define_flag_value flag_str dump_flag_fields
+define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
+);
+
+our $VERSION = '0.01';
+
+my %flag_fields;
+my %symbolic_fields;
+
+sub flag_str
+{
+ my ($event_name, $field_name, $value) = @_;
+
+ my $string;
+
+ if ($flag_fields{$event_name}{$field_name}) {
+ my $print_delim = 0;
+ foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
+ if (!$value && !$idx) {
+ $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
+ last;
+ }
+ if ($idx && ($value & $idx) == $idx) {
+ if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
+ $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
+ }
+ $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
+ $print_delim = 1;
+ $value &= ~$idx;
+ }
+ }
+ }
+
+ return $string;
+}
+
+sub define_flag_field
+{
+ my ($event_name, $field_name, $delim) = @_;
+
+ $flag_fields{$event_name}{$field_name}{"delim"} = $delim;
+}
+
+sub define_flag_value
+{
+ my ($event_name, $field_name, $value, $field_str) = @_;
+
+ $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
+}
+
+sub dump_flag_fields
+{
+ for my $event (keys %flag_fields) {
+ print "event $event:\n";
+ for my $field (keys %{$flag_fields{$event}}) {
+ print " field: $field:\n";
+ print " delim: $flag_fields{$event}{$field}{'delim'}\n";
+ foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
+ print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
+ }
+ }
+ }
+}
+
+sub symbol_str
+{
+ my ($event_name, $field_name, $value) = @_;
+
+ if ($symbolic_fields{$event_name}{$field_name}) {
+ foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
+ if (!$value && !$idx) {
+ return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
+ last;
+ }
+ if ($value == $idx) {
+ return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
+ }
+ }
+ }
+
+ return undef;
+}
+
+sub define_symbolic_field
+{
+ my ($event_name, $field_name) = @_;
+
+ # nothing to do, really
+}
+
+sub define_symbolic_value
+{
+ my ($event_name, $field_name, $value, $field_str) = @_;
+
+ $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
+}
+
+sub dump_symbolic_fields
+{
+ for my $event (keys %symbolic_fields) {
+ print "event $event:\n";
+ for my $field (keys %{$symbolic_fields{$event}}) {
+ print " field: $field:\n";
+ foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
+ print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
+ }
+ }
+ }
+}
+
+1;
+__END__
+=head1 NAME
+
+Perf::Trace::Core - Perl extension for perf trace
+
+=head1 SYNOPSIS
+
+ use Perf::Trace::Core
+
+=head1 SEE ALSO
+
+Perf (trace) documentation
+
+=head1 AUTHOR
+
+Tom Zanussi, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Tom Zanussi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+=cut
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 0000000..052f132
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
@@ -0,0 +1,88 @@
+package Perf::Trace::Util;
+
+use 5.010000;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs
+);
+
+our $VERSION = '0.01';
+
+sub avg
+{
+ my ($total, $n) = @_;
+
+ return $total / $n;
+}
+
+my $NSECS_PER_SEC = 1000000000;
+
+sub nsecs
+{
+ my ($secs, $nsecs) = @_;
+
+ return $secs * $NSECS_PER_SEC + $nsecs;
+}
+
+sub nsecs_secs {
+ my ($nsecs) = @_;
+
+ return $nsecs / $NSECS_PER_SEC;
+}
+
+sub nsecs_nsecs {
+ my ($nsecs) = @_;
+
+ return $nsecs - nsecs_secs($nsecs);
+}
+
+sub nsecs_str {
+ my ($nsecs) = @_;
+
+ my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));
+
+ return $str;
+}
+
+1;
+__END__
+=head1 NAME
+
+Perf::Trace::Util - Perl extension for perf trace
+
+=head1 SYNOPSIS
+
+ use Perf::Trace::Util;
+
+=head1 SEE ALSO
+
+Perf (trace) documentation
+
+=head1 AUTHOR
+
+Tom Zanussi, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Tom Zanussi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+=cut
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 0000000..61f9156
--- /dev/null
+++ b/tools/perf/scripts/perl/rw-by-file.pl
@@ -0,0 +1,105 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Display r/w activity for files read/written to for a given program
+
+# The common_* event handler fields are the most useful fields common to
+# all events. They don't necessarily correspond to the 'common_*' fields
+# in the status files. Those fields not available as handler params can
+# be retrieved via script functions of the form get_common_*().
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+# change this to the comm of the program you're interested in
+my $for_comm = "perf";
+
+my %reads;
+my %writes;
+
+sub syscalls::sys_enter_read
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
+
+ if ($common_comm eq $for_comm) {
+ $reads{$fd}{bytes_requested} += $count;
+ $reads{$fd}{total_reads}++;
+ }
+}
+
+sub syscalls::sys_enter_write
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
+
+ if ($common_comm eq $for_comm) {
+ $writes{$fd}{bytes_written} += $count;
+ $writes{$fd}{total_writes}++;
+ }
+}
+
+sub trace_end
+{
+ printf("file read counts for $for_comm:\n\n");
+
+ printf("%6s %10s %10s\n", "fd", "# reads", "bytes_requested");
+ printf("%6s %10s %10s\n", "------", "----------", "-----------");
+
+ foreach my $fd (sort {$reads{$b}{bytes_requested} <=>
+ $reads{$a}{bytes_requested}} keys %reads) {
+ my $total_reads = $reads{$fd}{total_reads};
+ my $bytes_requested = $reads{$fd}{bytes_requested};
+ printf("%6u %10u %10u\n", $fd, $total_reads, $bytes_requested);
+ }
+
+ printf("\nfile write counts for $for_comm:\n\n");
+
+ printf("%6s %10s %10s\n", "fd", "# writes", "bytes_written");
+ printf("%6s %10s %10s\n", "------", "----------", "-----------");
+
+ foreach my $fd (sort {$writes{$b}{bytes_written} <=>
+ $writes{$a}{bytes_written}} keys %writes) {
+ my $total_writes = $writes{$fd}{total_writes};
+ my $bytes_written = $writes{$fd}{bytes_written};
+ printf("%6u %10u %10u\n", $fd, $total_writes, $bytes_written);
+ }
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
+
+
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 0000000..da601fa
--- /dev/null
+++ b/tools/perf/scripts/perl/rw-by-pid.pl
@@ -0,0 +1,170 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Display r/w activity for all processes
+
+# The common_* event handler fields are the most useful fields common to
+# all events. They don't necessarily correspond to the 'common_*' fields
+# in the status files. Those fields not available as handler params can
+# be retrieved via script functions of the form get_common_*().
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+my %reads;
+my %writes;
+
+sub syscalls::sys_exit_read
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $ret) = @_;
+
+ if ($ret > 0) {
+ $reads{$common_pid}{bytes_read} += $ret;
+ } else {
+ if (!defined ($reads{$common_pid}{bytes_read})) {
+ $reads{$common_pid}{bytes_read} = 0;
+ }
+ $reads{$common_pid}{errors}{$ret}++;
+ }
+}
+
+sub syscalls::sys_enter_read
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $fd, $buf, $count) = @_;
+
+ $reads{$common_pid}{bytes_requested} += $count;
+ $reads{$common_pid}{total_reads}++;
+ $reads{$common_pid}{comm} = $common_comm;
+}
+
+sub syscalls::sys_exit_write
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $ret) = @_;
+
+ if ($ret <= 0) {
+ $writes{$common_pid}{errors}{$ret}++;
+ }
+}
+
+sub syscalls::sys_enter_write
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $fd, $buf, $count) = @_;
+
+ $writes{$common_pid}{bytes_written} += $count;
+ $writes{$common_pid}{total_writes}++;
+ $writes{$common_pid}{comm} = $common_comm;
+}
+
+sub trace_end
+{
+ printf("read counts by pid:\n\n");
+
+ printf("%6s %20s %10s %10s %10s\n", "pid", "comm",
+ "# reads", "bytes_requested", "bytes_read");
+ printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------",
+ "-----------", "----------", "----------");
+
+ foreach my $pid (sort {$reads{$b}{bytes_read} <=>
+ $reads{$a}{bytes_read}} keys %reads) {
+ my $comm = $reads{$pid}{comm};
+ my $total_reads = $reads{$pid}{total_reads};
+ my $bytes_requested = $reads{$pid}{bytes_requested};
+ my $bytes_read = $reads{$pid}{bytes_read};
+
+ printf("%6s %-20s %10s %10s %10s\n", $pid, $comm,
+ $total_reads, $bytes_requested, $bytes_read);
+ }
+
+ printf("\nfailed reads by pid:\n\n");
+
+ printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
+ printf("%6s %20s %6s %10s\n", "------", "--------------------",
+ "------", "----------");
+
+ foreach my $pid (keys %reads) {
+ my $comm = $reads{$pid}{comm};
+ foreach my $err (sort {$reads{$b}{comm} cmp $reads{$a}{comm}}
+ keys %{$reads{$pid}{errors}}) {
+ my $errors = $reads{$pid}{errors}{$err};
+
+ printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
+ }
+ }
+
+ printf("\nwrite counts by pid:\n\n");
+
+ printf("%6s %20s %10s %10s\n", "pid", "comm",
+ "# writes", "bytes_written");
+ printf("%6s %-20s %10s %10s\n", "------", "--------------------",
+ "-----------", "----------");
+
+ foreach my $pid (sort {$writes{$b}{bytes_written} <=>
+ $writes{$a}{bytes_written}} keys %writes) {
+ my $comm = $writes{$pid}{comm};
+ my $total_writes = $writes{$pid}{total_writes};
+ my $bytes_written = $writes{$pid}{bytes_written};
+
+ printf("%6s %-20s %10s %10s\n", $pid, $comm,
+ $total_writes, $bytes_written);
+ }
+
+ printf("\nfailed writes by pid:\n\n");
+
+ printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
+ printf("%6s %20s %6s %10s\n", "------", "--------------------",
+ "------", "----------");
+
+ foreach my $pid (keys %writes) {
+ my $comm = $writes{$pid}{comm};
+ foreach my $err (sort {$writes{$b}{comm} cmp $writes{$a}{comm}}
+ keys %{$writes{$pid}{errors}}) {
+ my $errors = $writes{$pid}{errors}{$err};
+
+ printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
+ }
+ }
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
diff --git a/tools/perf/scripts/perl/wakeup-latency.pl b/tools/perf/scripts/perl/wakeup-latency.pl
new file mode 100644
index 0000000..ed58ef2
--- /dev/null
+++ b/tools/perf/scripts/perl/wakeup-latency.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Display avg/min/max wakeup latency
+
+# The common_* event handler fields are the most useful fields common to
+# all events. They don't necessarily correspond to the 'common_*' fields
+# in the status files. Those fields not available as handler params can
+# be retrieved via script functions of the form get_common_*().
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+my %last_wakeup;
+
+my $max_wakeup_latency;
+my $min_wakeup_latency;
+my $total_wakeup_latency;
+my $total_wakeups;
+
+sub sched::sched_switch
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid,
+ $next_prio) = @_;
+
+ my $wakeup_ts = $last_wakeup{$common_cpu}{ts};
+ if ($wakeup_ts) {
+ my $switch_ts = nsecs($common_secs, $common_nsecs);
+ my $wakeup_latency = $switch_ts - $wakeup_ts;
+ if ($wakeup_latency > $max_wakeup_latency) {
+ $max_wakeup_latency = $wakeup_latency;
+ }
+ if ($wakeup_latency < $min_wakeup_latency) {
+ $min_wakeup_latency = $wakeup_latency;
+ }
+ $total_wakeup_latency += $wakeup_latency;
+ $total_wakeups++;
+ }
+ $last_wakeup{$common_cpu}{ts} = 0;
+}
+
+sub sched::sched_wakeup
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $comm, $pid, $prio, $success, $target_cpu) = @_;
+
+ $last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs);
+}
+
+sub trace_begin
+{
+ $min_wakeup_latency = 1000000000;
+ $max_wakeup_latency = 0;
+}
+
+sub trace_end
+{
+ printf("wakeup_latency stats:\n\n");
+ print "total_wakeups: $total_wakeups\n";
+ printf("avg_wakeup_latency (ns): %u\n",
+ avg($total_wakeup_latency, $total_wakeups));
+ printf("min_wakeup_latency (ns): %u\n", $min_wakeup_latency);
+ printf("max_wakeup_latency (ns): %u\n", $max_wakeup_latency);
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
diff --git a/tools/perf/scripts/perl/workqueue-stats.pl b/tools/perf/scripts/perl/workqueue-stats.pl
new file mode 100644
index 0000000..511302c
--- /dev/null
+++ b/tools/perf/scripts/perl/workqueue-stats.pl
@@ -0,0 +1,129 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Displays workqueue stats
+#
+# Usage:
+#
+# perf record -c 1 -f -a -R -e workqueue:workqueue_creation -e
+# workqueue:workqueue_destruction -e workqueue:workqueue_execution
+# -e workqueue:workqueue_insertion
+#
+# perf trace -p -s tools/perf/scripts/perl/workqueue-stats.pl
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+my @cpus;
+
+sub workqueue::workqueue_destruction
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{destroyed}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub workqueue::workqueue_creation
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid, $cpu) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{created}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub workqueue::workqueue_execution
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid, $func) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{executed}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub workqueue::workqueue_insertion
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid, $func) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{inserted}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub trace_end
+{
+ print "workqueue work stats:\n\n";
+ my $cpu = 0;
+ printf("%3s %6s %6s\t%-20s\n", "cpu", "ins", "exec", "name");
+ printf("%3s %6s %6s\t%-20s\n", "---", "---", "----", "----");
+ foreach my $pidhash (@cpus) {
+ while ((my $pid, my $wqhash) = each %$pidhash) {
+ my $ins = $$wqhash{'inserted'};
+ my $exe = $$wqhash{'executed'};
+ my $comm = $$wqhash{'comm'};
+ if ($ins || $exe) {
+ printf("%3u %6u %6u\t%-20s\n", $cpu, $ins, $exe, $comm);
+ }
+ }
+ $cpu++;
+ }
+
+ $cpu = 0;
+ print "\nworkqueue lifecycle stats:\n\n";
+ printf("%3s %6s %6s\t%-20s\n", "cpu", "created", "destroyed", "name");
+ printf("%3s %6s %6s\t%-20s\n", "---", "-------", "---------", "----");
+ foreach my $pidhash (@cpus) {
+ while ((my $pid, my $wqhash) = each %$pidhash) {
+ my $created = $$wqhash{'created'};
+ my $destroyed = $$wqhash{'destroyed'};
+ my $comm = $$wqhash{'comm'};
+ if ($created || $destroyed) {
+ printf("%3u %6u %6u\t%-20s\n", $cpu, $created, $destroyed,
+ $comm);
+ }
+ }
+ $cpu++;
+ }
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
--
1.6.4.GIT
The Perl scripting support for perf trace allows most of a trace
event's data to be accessed directly as handler arguments, but not all
of it e.g. the less common fields aren't passed in. To give scripts
access to the other fields and/or any other data or metadata in the
main perf executable that might be useful, a way to access the C data
in perf from Perl is needed; this patch uses the Perl XS facility to
do it for the common_xxx event fields not passed to handler functions.
Context.pm exports three functions to Perl scripts that access fields
for the current event by calling back into perf: common_pc(),
common_flags() and common_lock_depth(). Support for common_flags()
field values was added to Core.pm and a script used to sanity check
these and other basic scripting features, check-perf-trace.pl, was
also added.
Signed-off-by: Tom Zanussi <[email protected]>
---
tools/perf/Makefile | 6 +-
tools/perf/scripts/perl/Perf-Trace-Util/Context.c | 134 ++++++++++++++++++++
tools/perf/scripts/perl/Perf-Trace-Util/Context.xs | 41 ++++++
.../perf/scripts/perl/Perf-Trace-Util/Makefile.PL | 11 ++-
tools/perf/scripts/perl/Perf-Trace-Util/README | 34 +++++-
.../perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm | 55 ++++++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | 35 +++++
tools/perf/scripts/perl/Perf-Trace-Util/typemap | 1 +
tools/perf/scripts/perl/check-perf-trace.pl | 106 ++++++++++++++++
tools/perf/util/trace-event-parse.c | 6 +-
tools/perf/util/trace-event-perl.c | 46 +++++++-
tools/perf/util/trace-event-perl.h | 9 ++
tools/perf/util/trace-event.h | 3 +
13 files changed, 474 insertions(+), 13 deletions(-)
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/Context.c
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
create mode 100644 tools/perf/scripts/perl/Perf-Trace-Util/typemap
create mode 100644 tools/perf/scripts/perl/check-perf-trace.pl
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index f536fff..0bce5d1 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -511,6 +511,7 @@ ifneq ($(shell sh -c "(echo '\#include <EXTERN.h>'; echo '\#include <perl.h>'; e
BASIC_CFLAGS += -DNO_LIBPERL
else
ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
+ LIB_OBJS += scripts/perl/Perf-Trace-Util/Context.o
endif
ifdef NO_DEMANGLE
@@ -887,6 +888,9 @@ util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
$(QUIET_CC)$(CC) -o util/trace-event-perl.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter $<
+scripts/perl/Perf-Trace-Util/Context.o: scripts/perl/Perf-Trace-Util/Context.c PERF-CFLAGS
+ $(QUIET_CC)$(CC) -o scripts/perl/Perf-Trace-Util/Context.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter -Wno-nested-externs $<
+
perf-%$X: %.o $(PERFLIBS)
$(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
@@ -1086,7 +1090,7 @@ distclean: clean
# $(RM) configure
clean:
- $(RM) *.o */*.o $(LIB_FILE)
+ $(RM) *.o */*.o */*/*.o */*/*/*.o $(LIB_FILE)
$(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X
$(RM) $(TEST_PROGRAMS)
$(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope*
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 0000000..3ba3ffc
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
@@ -0,0 +1,134 @@
+/*
+ * This file was generated automatically by ExtUtils::ParseXS version 2.18_02 from the
+ * contents of Context.xs. Do not edit this file, edit Context.xs instead.
+ *
+ * ANY CHANGES MADE HERE WILL BE LOST!
+ *
+ */
+
+#line 1 "Context.xs"
+/*
+ * Context.xs. XS interfaces for perf trace.
+ *
+ * Copyright (C) 2009 Tom Zanussi <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "../../../util/trace-event-perl.h"
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+#line 41 "Context.c"
+
+XS(XS_Perf__Trace__Context_get_common_pc); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_common_pc)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ if (items != 1)
+ Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_pc", "context");
+ PERL_UNUSED_VAR(cv); /* -W */
+ {
+ struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
+ int RETVAL;
+ dXSTARG;
+
+ RETVAL = get_common_pc(context);
+ XSprePUSH; PUSHi((IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+
+XS(XS_Perf__Trace__Context_get_common_flags); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_common_flags)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ if (items != 1)
+ Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_flags", "context");
+ PERL_UNUSED_VAR(cv); /* -W */
+ {
+ struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
+ int RETVAL;
+ dXSTARG;
+
+ RETVAL = get_common_flags(context);
+ XSprePUSH; PUSHi((IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+
+XS(XS_Perf__Trace__Context_get_common_lock_depth); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_common_lock_depth)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ if (items != 1)
+ Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_lock_depth", "context");
+ PERL_UNUSED_VAR(cv); /* -W */
+ {
+ struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
+ int RETVAL;
+ dXSTARG;
+
+ RETVAL = get_common_lock_depth(context);
+ XSprePUSH; PUSHi((IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+#ifdef __cplusplus
+extern "C"
+#endif
+XS(boot_Perf__Trace__Context); /* prototype to pass -Wmissing-prototypes */
+XS(boot_Perf__Trace__Context)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ const char* file = __FILE__;
+
+ PERL_UNUSED_VAR(cv); /* -W */
+ PERL_UNUSED_VAR(items); /* -W */
+ XS_VERSION_BOOTCHECK ;
+
+ newXSproto("Perf::Trace::Context::get_common_pc", XS_Perf__Trace__Context_get_common_pc, file, "$");
+ newXSproto("Perf::Trace::Context::get_common_flags", XS_Perf__Trace__Context_get_common_flags, file, "$");
+ newXSproto("Perf::Trace::Context::get_common_lock_depth", XS_Perf__Trace__Context_get_common_lock_depth, file, "$");
+ if (PL_unitcheckav)
+ call_list(PL_scopestack_ix, PL_unitcheckav);
+ XSRETURN_YES;
+}
+
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 0000000..24facb3
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
@@ -0,0 +1,41 @@
+/*
+ * Context.xs. XS interfaces for perf trace.
+ *
+ * Copyright (C) 2009 Tom Zanussi <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "../../../util/trace-event-perl.h"
+
+MODULE = Perf::Trace::Context PACKAGE = Perf::Trace::Context
+PROTOTYPES: ENABLE
+
+int
+get_common_pc(context)
+ struct scripting_context * context
+
+int
+get_common_flags(context)
+ struct scripting_context * context
+
+int
+get_common_lock_depth(context)
+ struct scripting_context * context
+
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
index b0de02e..decdeb0 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
@@ -3,10 +3,15 @@ use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
- NAME => 'Perf::Trace::Util',
- VERSION_FROM => 'lib/Perf/Trace/Util.pm', # finds $VERSION
+ NAME => 'Perf::Trace::Context',
+ VERSION_FROM => 'lib/Perf/Trace/Context.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'lib/Perf/Trace/Util.pm', # retrieve abstract from module
+ (ABSTRACT_FROM => 'lib/Perf/Trace/Context.pm', # retrieve abstract from module
AUTHOR => 'Tom Zanussi <[email protected]>') : ()),
+ LIBS => [''], # e.g., '-lm'
+ DEFINE => '-I ../..', # e.g., '-DHAVE_SOMETHING'
+ INC => '-I.', # e.g., '-I. -I/usr/include/other'
+ # Un-comment this if you add C files to link with later:
+ OBJECT => 'Context.o', # link all the C files too
);
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/README b/tools/perf/scripts/perl/Perf-Trace-Util/README
index 0a58378..adb99aa 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/README
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/README
@@ -3,6 +3,34 @@ Perf-Trace-Util version 0.01
This module contains utility functions for use with perf trace.
+Core.pm and Util.pm are pure Perl modules; Core.pm contains routines
+that the core perf support for Perl calls on and should always be
+'used', while Util.pm contains useful but optional utility functions
+that scripts may want to use. Context.pm contains the Perl->C
+interface that allows scripts to access data in the embedding perf
+executable; scripts wishing to do that should 'use Context.pm'.
+
+The Perl->C perf interface is completely driven by Context.xs. If you
+want to add new Perl functions that end up accessing C data in the
+perf executable, you add desciptions of the new functions here.
+scripting_context is a pointer to the perf data in the perf executable
+that you want to access - it's passed as the second parameter,
+$context, to all handler functions.
+
+After you do that:
+
+ perl Makefile.PL # to create a Makefile for the next step
+ make # to create Context.c
+
+ edit Context.c to add const to the char* file = __FILE__ line in
+ XS(boot_Perf__Trace__Context) to silence a warning/error.
+
+ You can delete the Makefile, object files and anything else that was
+ generated e.g. blib and shared library, etc, except for of course
+ Context.c
+
+ You should then be able to run the normal perf make as usual.
+
INSTALLATION
Building perf with perf trace Perl scripting should install this
@@ -15,12 +43,10 @@ DEPENDENCIES
This module requires these other modules and libraries:
- blah blah blah
+ None
COPYRIGHT AND LICENCE
-Put the correct copyright and licence information here.
-
Copyright (C) 2009 by Tom Zanussi <[email protected]>
This library is free software; you can redistribute it and/or modify
@@ -31,5 +57,3 @@ Alternatively, this software may be distributed under the terms of the
GNU General Public License ("GPL") version 2 as published by the Free
Software Foundation.
-
-
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 0000000..6c7f365
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
@@ -0,0 +1,55 @@
+package Perf::Trace::Context;
+
+use 5.010000;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+ common_pc common_flags common_lock_depth
+);
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('Perf::Trace::Context', $VERSION);
+
+1;
+__END__
+=head1 NAME
+
+Perf::Trace::Context - Perl extension for accessing functions in perf.
+
+=head1 SYNOPSIS
+
+ use Perf::Trace::Context;
+
+=head1 SEE ALSO
+
+Perf (trace) documentation
+
+=head1 AUTHOR
+
+Tom Zanussi, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Tom Zanussi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+=cut
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
index fd250fb..9df376a 100644
--- 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
@@ -16,10 +16,45 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
define_flag_field define_flag_value flag_str dump_flag_fields
define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
+trace_flag_str
);
our $VERSION = '0.01';
+my %trace_flags = (0x00 => "NONE",
+ 0x01 => "IRQS_OFF",
+ 0x02 => "IRQS_NOSUPPORT",
+ 0x04 => "NEED_RESCHED",
+ 0x08 => "HARDIRQ",
+ 0x10 => "SOFTIRQ");
+
+sub trace_flag_str
+{
+ my ($value) = @_;
+
+ my $string;
+
+ my $print_delim = 0;
+
+ foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
+ if (!$value && !$idx) {
+ $string .= "NONE";
+ last;
+ }
+
+ if ($idx && ($value & $idx) == $idx) {
+ if ($print_delim) {
+ $string .= " | ";
+ }
+ $string .= "$trace_flags{$idx}";
+ $print_delim = 1;
+ $value &= ~$idx;
+ }
+ }
+
+ return $string;
+}
+
my %flag_fields;
my %symbolic_fields;
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 0000000..8408368
--- /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/check-perf-trace.pl b/tools/perf/scripts/perl/check-perf-trace.pl
new file mode 100644
index 0000000..4e7dc0a
--- /dev/null
+++ b/tools/perf/scripts/perl/check-perf-trace.pl
@@ -0,0 +1,106 @@
+# perf trace event handlers, generated by perf trace -g perl
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# This script tests basic functionality such as flag and symbol
+# strings, common_xxx() calls back into perf, begin, end, unhandled
+# events, etc. Basically, if this script runs successfully and
+# displays expected results, perl scripting support should be ok.
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Context;
+use Perf::Trace::Util;
+
+sub trace_begin
+{
+ print "trace_begin\n";
+}
+
+sub trace_end
+{
+ print "trace_end\n";
+
+ print_unhandled();
+}
+
+sub irq::softirq_entry
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $vec) = @_;
+
+ print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm);
+
+ print_uncommon($context);
+
+ printf("vec=%s\n",
+ symbol_str("irq::softirq_entry", "vec", $vec));
+}
+
+sub kmem::kmalloc
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $call_site, $ptr, $bytes_req, $bytes_alloc,
+ $gfp_flags) = @_;
+
+ print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm);
+
+ print_uncommon($context);
+
+ printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
+ "gfp_flags=%s\n",
+ $call_site, $ptr, $bytes_req, $bytes_alloc,
+
+ flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
+}
+
+# print trace fields not included in handler args
+sub print_uncommon
+{
+ my ($context) = @_;
+
+ printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
+ common_pc($context), trace_flag_str(common_flags($context)),
+ common_lock_depth($context));
+
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
+
+sub print_header
+{
+ my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
+
+ printf("%-20s %5u %05u.%09u %8u %-20s ",
+ $event_name, $cpu, $secs, $nsecs, $pid, $comm);
+}
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index 600d52e..180368b 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -1981,7 +1981,7 @@ int trace_parse_common_pid(void *data)
"common_pid");
}
-static int parse_common_pc(void *data)
+int parse_common_pc(void *data)
{
static int pc_offset;
static int pc_size;
@@ -1990,7 +1990,7 @@ static int parse_common_pc(void *data)
"common_preempt_count");
}
-static int parse_common_flags(void *data)
+int parse_common_flags(void *data)
{
static int flags_offset;
static int flags_size;
@@ -1999,7 +1999,7 @@ static int parse_common_flags(void *data)
"common_flags");
}
-static int parse_common_lock_depth(void *data)
+int parse_common_lock_depth(void *data)
{
static int ld_offset;
static int ld_size;
diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c
index c56b08d..d179ade 100644
--- a/tools/perf/util/trace-event-perl.c
+++ b/tools/perf/util/trace-event-perl.c
@@ -30,6 +30,21 @@
#include "trace-event.h"
#include "trace-event-perl.h"
+void xs_init(pTHX);
+
+void boot_Perf__Trace__Context(pTHX_ CV *cv);
+void boot_DynaLoader(pTHX_ CV *cv);
+
+void xs_init(pTHX)
+{
+ const char *file = __FILE__;
+ dXSUB_SYS;
+
+ newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context,
+ file);
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
INTERP my_perl;
#define FTRACE_MAX_EVENT \
@@ -227,6 +242,33 @@ static inline struct event *find_cache_event(int type)
return event;
}
+int get_common_pc(struct scripting_context *context)
+{
+ int pc;
+
+ pc = parse_common_pc(context->event_data);
+
+ return pc;
+}
+
+int get_common_flags(struct scripting_context *context)
+{
+ int flags;
+
+ flags = parse_common_flags(context->event_data);
+
+ return flags;
+}
+
+int get_common_lock_depth(struct scripting_context *context)
+{
+ int lock_depth;
+
+ lock_depth = parse_common_lock_depth(context->event_data);
+
+ return lock_depth;
+}
+
static void perl_process_event(int cpu, void *data,
int size __attribute((unused)),
unsigned long long nsecs, char *comm)
@@ -290,6 +332,7 @@ static void perl_process_event(int cpu, void *data,
}
PUTBACK;
+
if (get_cv(handler, 0))
call_pv(handler, G_SCALAR);
else if (get_cv("main::trace_unhandled", 0)) {
@@ -328,7 +371,8 @@ static int perl_start_script(const char *script)
my_perl = perl_alloc();
perl_construct(my_perl);
- if (perl_parse(my_perl, NULL, 2, (char **)command_line, (char **)NULL))
+ if (perl_parse(my_perl, xs_init, 2, (char **)command_line,
+ (char **)NULL))
return -1;
perl_run(my_perl);
diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h
index 6c94fa9..666a864 100644
--- a/tools/perf/util/trace-event-perl.h
+++ b/tools/perf/util/trace-event-perl.h
@@ -29,6 +29,11 @@ typedef int INTERP;
#define perl_run(a) (0)
#define perl_destruct(a) (0)
#define perl_free(a) (0)
+#define pTHX void
+#define CV void
+#define dXSUB_SYS
+#define pTHX_
+static inline void newXS(const char *a, void *b, const char *c) {}
#else
#include <EXTERN.h>
#include <perl.h>
@@ -39,4 +44,8 @@ struct scripting_context {
void *event_data;
};
+int get_common_pc(struct scripting_context *context);
+int get_common_flags(struct scripting_context *context);
+int get_common_lock_depth(struct scripting_context *context);
+
#endif /* __PERF_TRACE_EVENT_PERL_H */
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index b1e58d3..81698d5 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -246,6 +246,9 @@ extern int latency_format;
int parse_header_page(char *buf, unsigned long size);
int trace_parse_common_type(void *data);
int trace_parse_common_pid(void *data);
+int parse_common_pc(void *data);
+int parse_common_flags(void *data);
+int parse_common_lock_depth(void *data);
struct event *trace_find_event(int id);
struct event *trace_find_next_event(struct event *event);
unsigned long long read_size(void *ptr, int size);
--
1.6.4.GIT
Adds perf-trace-perl Documentation and a link to it from the
perf-trace page.
Signed-off-by: Tom Zanussi <[email protected]>
---
tools/perf/Documentation/perf-trace-perl.txt | 219 ++++++++++++++++++++++++++
tools/perf/Documentation/perf-trace.txt | 11 ++-
2 files changed, 229 insertions(+), 1 deletions(-)
create mode 100644 tools/perf/Documentation/perf-trace-perl.txt
diff --git a/tools/perf/Documentation/perf-trace-perl.txt b/tools/perf/Documentation/perf-trace-perl.txt
new file mode 100644
index 0000000..c5f55f4
--- /dev/null
+++ b/tools/perf/Documentation/perf-trace-perl.txt
@@ -0,0 +1,219 @@
+perf-trace-perl(1)
+==================
+
+NAME
+----
+perf-trace-perl - Process trace data with a Perl script
+
+SYNOPSIS
+--------
+[verse]
+'perf trace' [-s [lang]:script[.ext] ]
+
+DESCRIPTION
+-----------
+
+This perf trace option is used to process perf trace data using perf's
+built-in Perl interpreter. It reads and processes the input file and
+displays the results of the trace analysis implemented in the given
+Perl script, if any.
+
+STARTER SCRIPTS
+---------------
+
+You can avoid reading the rest of this document by running 'perf trace
+-g perl' in the same directory as an existing perf.data trace file.
+That will generate a starter script containing a handler for each of
+the event types in the trace file; it simply prints every available
+field for each event in the trace file.
+
+You can also look at the existing scripts in
+~/libexec/perf-core/scripts/perl for typical examples showing how to
+do basic things like aggregate event data, print results, etc. Also,
+the check-perf-trace.pl script, while not interesting for its results,
+attempts to exercise all of the main scripting features.
+
+EVENT HANDLERS
+--------------
+
+When perf trace is invoked using a trace script, a user-defined
+'handler function' is called for each event in the trace. If there's
+no handler function defined for a given event type, the event is
+ignored (or passed to a 'trace_handled' function, see below) and the
+next event is processed.
+
+Most of the event's field values are passed as arguments to the
+handler function; some of the less common ones aren't - those are
+available as calls back into the perf executable (see below).
+
+As an example, the following perf record command can be used to record
+all sched_wakeup events in the system:
+
+ # perf record -c 1 -f -a -M -R -e sched:sched_wakeup
+
+Traces meant to be processed using a script should be recorded with
+the above options: -c 1 says to sample every event, -a to enable
+system-wide collection, -M to multiplex the output, and -R to collect
+raw samples.
+
+The format file for the sched_wakep event defines the following fields
+(see /sys/kernel/debug/tracing/events/sched/sched_wakeup/format):
+
+----
+ format:
+ field:unsigned short common_type;
+ field:unsigned char common_flags;
+ field:unsigned char common_preempt_count;
+ field:int common_pid;
+ field:int common_lock_depth;
+
+ field:char comm[TASK_COMM_LEN];
+ field:pid_t pid;
+ field:int prio;
+ field:int success;
+ field:int target_cpu;
+----
+
+The handler function for this event would be defined as:
+
+----
+sub sched::sched_wakeup
+{
+ my ($event_name, $context, $common_cpu, $common_secs,
+ $common_nsecs, $common_pid, $common_comm,
+ $comm, $pid, $prio, $success, $target_cpu) = @_;
+}
+----
+
+The handler function takes the form subsystem::event_name.
+
+The $common_* arguments in the handler's argument list are the set of
+arguments passed to all event handlers; some of the fields correspond
+to the common_* fields in the format file, but some are synthesized,
+and some of the common_* fields aren't common enough to to be passed
+to every event as arguments but are available as library functions.
+
+Here's a brief description of each of the invariant event args:
+
+ $event_name the name of the event as text
+ $context an opaque 'cookie' used in calls back into perf
+ $common_cpu the cpu the event occurred on
+ $common_secs the secs portion of the event timestamp
+ $common_nsecs the nsecs portion of the event timestamp
+ $common_pid the pid of the current task
+ $common_comm the name of the current process
+
+All of the remaining fields in the event's format file have
+counterparts as handler function arguments of the same name, as can be
+seen in the example above.
+
+The above provides the basics needed to directly access every field of
+every event in a trace, which covers 90% of what you need to know to
+write a useful trace script. The sections below cover the rest.
+
+SCRIPT LAYOUT
+-------------
+
+Every perf trace Perl script should start by setting up a Perl module
+search path and 'use'ing a few support modules (see module
+descriptions below):
+
+----
+ use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+ use lib "./Perf-Trace-Util/lib";
+ use Perf::Trace::Core;
+ use Perf::Trace::Context;
+ use Perf::Trace::Util;
+----
+
+The rest of the script can contain handler functions and support
+functions in any order.
+
+Aside from the event handler functions discussed above, every script
+can implement a set of optional functions:
+
+*trace_begin*, if defined, is called before any event is processed and
+gives scripts a chance to do setup tasks:
+
+----
+ sub trace_begin
+ {
+ }
+----
+
+*trace_end*, if defined, is called after all events have been
+ processed and gives scripts a chance to do end-of-script tasks, such
+ as display results:
+
+----
+sub trace_end
+{
+}
+----
+
+*trace_unhandled*, if defined, is called after for any event that
+ doesn't have a handler explicitly defined for it. The standard set
+ of common arguments are passed into it:
+
+----
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs,
+ $common_nsecs, $common_pid, $common_comm) = @_;
+}
+----
+
+The remaining sections provide descriptions of each of the available
+built-in perf trace Perl modules and their associated functions.
+
+AVAILABLE MODULES AND FUNCTIONS
+-------------------------------
+
+The following sections describe the functions and variables available
+via the various Perf::Trace::* Perl modules. To use the functions and
+variables from the given module, add the corresponding 'use
+Perf::Trace::XXX' line to your perf trace script.
+
+Perf::Trace::Core Module
+~~~~~~~~~~~~~~~~~~~~~~~~
+
+These functions provide some essential functions to user scripts.
+
+The *flag_str* and *symbol_str* functions provide human-readable
+strings for flag and symbolic fields. These correspond to the strings
+and values parsed from the 'print fmt' fields of the event format
+files:
+
+ flag_str($event_name, $field_name, $field_value) - returns the string represention corresponding to $field_value for the flag field $field_name of event $event_name
+ symbol_str($event_name, $field_name, $field_value) - returns the string represention corresponding to $field_value for the symbolic field $field_name of event $event_name
+
+Perf::Trace::Context Module
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Some of the 'common' fields in the event format file aren't all that
+common, but need to be made accessible to user scripts nonetheless.
+
+Perf::Trace::Context defines a set of functions that can be used to
+access this data in the context of the current event. Each of these
+functions expects a $context variable, which is the same as the
+$context variable passed into every event handler as the second
+argument.
+
+ common_pc($context) - returns common_preempt count for the current event
+ common_flags($context) - returns common_flags for the current event
+ common_lock_depth($context) - returns common_lock_depth for the current event
+
+Perf::Trace::Util Module
+~~~~~~~~~~~~~~~~~~~~~~~~
+
+Various utility functions for use with perf trace:
+
+ nsecs($secs, $nsecs) - returns total nsecs given secs/nsecs pair
+ nsecs_secs($nsecs) - returns whole secs portion given nsecs
+ nsecs_nsecs($nsecs) - returns nsecs remainder given nsecs
+ nsecs_str($nsecs) - returns printable string in the form secs.nsecs
+ avg($total, $n) - returns average given a sum and a total number of values
+
+SEE ALSO
+--------
+linkperf:perf-trace[1]
diff --git a/tools/perf/Documentation/perf-trace.txt b/tools/perf/Documentation/perf-trace.txt
index 41ed753..07065ef 100644
--- a/tools/perf/Documentation/perf-trace.txt
+++ b/tools/perf/Documentation/perf-trace.txt
@@ -20,6 +20,15 @@ OPTIONS
--dump-raw-trace=::
Display verbose dump of the trace data.
+-s::
+--script=::
+ Process trace data with the given script ([lang]:script[.ext]).
+
+-g::
+--gen-script=::
+ Generate perf-trace.[ext] starter script for given language,
+ using current perf.data.
+
SEE ALSO
--------
-linkperf:perf-record[1]
+linkperf:perf-record[1], linkperf:perf-trace-perl[1]
--
1.6.4.GIT
To capture the relevant events for a given Perl script and to avoid
having to continually remember and type in long command-lines, add a
scripts/perl/bin directory containing two simple shell scripts for
each Perl script, one for recording and one for processing/display.
For example, to record perf data for the rw-by-pid.pl script, run
scripts/perl/bin/rw-by-pid-record and to actually run the script and
display the output run scripts/perl/bin/rw-by-pid-report.
Signed-off-by: Tom Zanussi <[email protected]>
---
.../perf/scripts/perl/bin/check-perf-trace-record | 7 +++++++
.../perf/scripts/perl/bin/check-perf-trace-report | 5 +++++
tools/perf/scripts/perl/bin/rw-by-file-record | 2 ++
tools/perf/scripts/perl/bin/rw-by-file-report | 5 +++++
tools/perf/scripts/perl/bin/rw-by-pid-record | 2 ++
tools/perf/scripts/perl/bin/rw-by-pid-report | 5 +++++
tools/perf/scripts/perl/bin/wakeup-latency-record | 6 ++++++
tools/perf/scripts/perl/bin/wakeup-latency-report | 5 +++++
tools/perf/scripts/perl/bin/workqueue-stats-record | 2 ++
tools/perf/scripts/perl/bin/workqueue-stats-report | 6 ++++++
10 files changed, 45 insertions(+), 0 deletions(-)
create mode 100644 tools/perf/scripts/perl/bin/check-perf-trace-record
create mode 100644 tools/perf/scripts/perl/bin/check-perf-trace-report
create mode 100644 tools/perf/scripts/perl/bin/rw-by-file-record
create mode 100644 tools/perf/scripts/perl/bin/rw-by-file-report
create mode 100644 tools/perf/scripts/perl/bin/rw-by-pid-record
create mode 100644 tools/perf/scripts/perl/bin/rw-by-pid-report
create mode 100644 tools/perf/scripts/perl/bin/wakeup-latency-record
create mode 100644 tools/perf/scripts/perl/bin/wakeup-latency-report
create mode 100644 tools/perf/scripts/perl/bin/workqueue-stats-record
create mode 100644 tools/perf/scripts/perl/bin/workqueue-stats-report
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 0000000..c7ec5de
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/check-perf-trace-record
@@ -0,0 +1,7 @@
+#!/bin/bash
+perf record -c 1 -f -a -M -R -e kmem:kmalloc -e irq:softirq_entry
+
+
+
+
+
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 0000000..89948b0
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/check-perf-trace-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/check-perf-trace.pl
+
+
+
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 0000000..b25056e
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-file-record
@@ -0,0 +1,2 @@
+#!/bin/bash
+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 0000000..f5dcf9c
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-file-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl
+
+
+
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 0000000..8903979
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-pid-record
@@ -0,0 +1,2 @@
+#!/bin/bash
+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 0000000..cea16f7
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-pid-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl
+
+
+
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 0000000..6abedda
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/wakeup-latency-record
@@ -0,0 +1,6 @@
+#!/bin/bash
+perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup
+
+
+
+
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 0000000..85769dc
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/wakeup-latency-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl
+
+
+
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 0000000..fce6637
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/workqueue-stats-record
@@ -0,0 +1,2 @@
+#!/bin/bash
+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 0000000..aa68435
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/workqueue-stats-report
@@ -0,0 +1,6 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl
+
+
+
+
--
1.6.4.GIT
On Wed, 2009-11-25 at 01:15 -0600, Tom Zanussi wrote:
> sched::sched_wakeup 0 01238.657997033 6183 firefox comm=firefox, pid=6199, prio=120, success=1, target_cpu=1
> sched::sched_switch 1 01238.657991740 7140 firefox prev_comm=firefox, prev_pid=7140, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6199, next_prio=120
>
> min_wakeup_latency: -5293
Looks like we missed a clock update on the cross cpu wakeup, Mike was
busy plugging those holes -- I've been starting at a patch that might
cure this (amongst other things).
On Wed, 2009-11-25 at 09:28 +0100, Peter Zijlstra wrote:
> On Wed, 2009-11-25 at 01:15 -0600, Tom Zanussi wrote:
> > sched::sched_wakeup 0 01238.657997033 6183 firefox comm=firefox, pid=6199, prio=120, success=1, target_cpu=1
> > sched::sched_switch 1 01238.657991740 7140 firefox prev_comm=firefox, prev_pid=7140, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6199, next_prio=120
> >
> > min_wakeup_latency: -5293
>
> Looks like we missed a clock update on the cross cpu wakeup, Mike was
> busy plugging those holes -- I've been starting at a patch that might
> cure this (amongst other things).
Hmm, current -tip should have that cured as per:
---
commit 055a00865dcfc8e61f3cbefbb879c9577bd36ae5
Author: Mike Galbraith <[email protected]>
Date: Thu Nov 12 11:07:44 2009 +0100
sched: Fix/add missing update_rq_clock() calls
kthread_bind(), migrate_task() and sched_fork were missing
updates, and try_to_wake_up() was updating after having already
used the stale clock.
Aside from preventing potential latency hits, there' a side
benefit in that early boot printk time stamps become monotonic.
Signed-off-by: Mike Galbraith <[email protected]>
Acked-by: Peter Zijlstra <[email protected]>
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
LKML-Reference: <new-submission>
diff --git a/kernel/sched.c b/kernel/sched.c
index 3c11ae0..701eca4 100644
--- a/kernel/sched.c
+++ b/kernel/sched.c
@@ -2017,6 +2017,7 @@ void kthread_bind(struct task_struct *p, unsigned int cpu)
}
spin_lock_irqsave(&rq->lock, flags);
+ update_rq_clock(rq);
set_task_cpu(p, cpu);
p->cpus_allowed = cpumask_of_cpu(cpu);
p->rt.nr_cpus_allowed = 1;
@@ -2115,6 +2116,7 @@ migrate_task(struct task_struct *p, int dest_cpu, struct migration_req *req)
* it is sufficient to simply update the task's cpu field.
*/
if (!p->se.on_rq && !task_running(rq, p)) {
+ update_rq_clock(rq);
set_task_cpu(p, dest_cpu);
return 0;
}
@@ -2376,14 +2378,15 @@ static int try_to_wake_up(struct task_struct *p, unsigned int state,
task_rq_unlock(rq, &flags);
cpu = p->sched_class->select_task_rq(p, SD_BALANCE_WAKE, wake_flags);
- if (cpu != orig_cpu)
+ if (cpu != orig_cpu) {
+ local_irq_save(flags);
+ rq = cpu_rq(cpu);
+ update_rq_clock(rq);
set_task_cpu(p, cpu);
-
+ local_irq_restore(flags);
+ }
rq = task_rq_lock(p, &flags);
- if (rq != orig_rq)
- update_rq_clock(rq);
-
WARN_ON(p->state != TASK_WAKING);
cpu = task_cpu(p);
@@ -2545,6 +2548,7 @@ static void __sched_fork(struct task_struct *p)
void sched_fork(struct task_struct *p, int clone_flags)
{
int cpu = get_cpu();
+ unsigned long flags;
__sched_fork(p);
@@ -2581,7 +2585,10 @@ void sched_fork(struct task_struct *p, int clone_flags)
#ifdef CONFIG_SMP
cpu = p->sched_class->select_task_rq(p, SD_BALANCE_FORK, 0);
#endif
+ local_irq_save(flags);
+ update_rq_clock(cpu_rq(cpu));
set_task_cpu(p, cpu);
+ local_irq_restore(flags);
#if defined(CONFIG_SCHEDSTATS) || defined(CONFIG_TASK_DELAY_ACCT)
if (likely(sched_info_on()))
* Peter Zijlstra <[email protected]> wrote:
> On Wed, 2009-11-25 at 09:28 +0100, Peter Zijlstra wrote:
> > On Wed, 2009-11-25 at 01:15 -0600, Tom Zanussi wrote:
> > > sched::sched_wakeup 0 01238.657997033 6183 firefox comm=firefox, pid=6199, prio=120, success=1, target_cpu=1
> > > sched::sched_switch 1 01238.657991740 7140 firefox prev_comm=firefox, prev_pid=7140, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6199, next_prio=120
> > >
> > > min_wakeup_latency: -5293
> >
> > Looks like we missed a clock update on the cross cpu wakeup, Mike was
> > busy plugging those holes -- I've been starting at a patch that might
> > cure this (amongst other things).
>
> Hmm, current -tip should have that cured as per:
well, but timestamp inconsistencies are still possible fundamentally, as
cpu_clock() is not globally serialized.
If so then the (hack only) patch below would cure those timestamp
inconsistencies?
Ingo
Not-Signed-off-by-me
diff --git a/kernel/perf_event.c b/kernel/perf_event.c
index 35df94e..4f36b47 100644
--- a/kernel/perf_event.c
+++ b/kernel/perf_event.c
@@ -248,7 +248,7 @@ static void perf_unpin_context(struct perf_event_context *ctx)
static inline u64 perf_clock(void)
{
- return cpu_clock(smp_processor_id());
+ return trace_clock_global();
}
/*
On Wed, 2009-11-25 at 10:43 +0100, Ingo Molnar wrote:
> * Peter Zijlstra <[email protected]> wrote:
>
> > On Wed, 2009-11-25 at 09:28 +0100, Peter Zijlstra wrote:
> > > On Wed, 2009-11-25 at 01:15 -0600, Tom Zanussi wrote:
> > > > sched::sched_wakeup 0 01238.657997033 6183 firefox comm=firefox, pid=6199, prio=120, success=1, target_cpu=1
> > > > sched::sched_switch 1 01238.657991740 7140 firefox prev_comm=firefox, prev_pid=7140, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6199, next_prio=120
> > > >
> > > > min_wakeup_latency: -5293
> > >
> > > Looks like we missed a clock update on the cross cpu wakeup, Mike was
> > > busy plugging those holes -- I've been starting at a patch that might
> > > cure this (amongst other things).
> >
> > Hmm, current -tip should have that cured as per:
>
> well, but timestamp inconsistencies are still possible fundamentally, as
> cpu_clock() is not globally serialized.
No, but the cross-cpu update should have pulled 1 to the same time as 0.
So what we see here is that at wakeup time, cpu0 has 01238.657997033, if
it at that time does a cross-cpu clock update, sched_clock_remote()
should pull cpu1's time to that same time (unless cpu1 is ahead, but
given the situation that's clearly not the case).
The clock update on cpu1's schedule() would then either find a negative
increment, not further updating the time, but refreshing the raw tsc
stamp so that future updates appear monotonic, or find a positive stamp,
resulting in fwd time movement.
In any case, the wakeup latency should appear >= 0.
On Wed, 2009-11-25 at 10:58 +0100, Peter Zijlstra wrote:
> On Wed, 2009-11-25 at 10:43 +0100, Ingo Molnar wrote:
> > * Peter Zijlstra <[email protected]> wrote:
> >
> > > On Wed, 2009-11-25 at 09:28 +0100, Peter Zijlstra wrote:
> > > > On Wed, 2009-11-25 at 01:15 -0600, Tom Zanussi wrote:
> > > > > sched::sched_wakeup 0 01238.657997033 6183 firefox comm=firefox, pid=6199, prio=120, success=1, target_cpu=1
> > > > > sched::sched_switch 1 01238.657991740 7140 firefox prev_comm=firefox, prev_pid=7140, prev_prio=120, prev_state=S, next_comm=firefox, next_pid=6199, next_prio=120
> > > > >
> > > > > min_wakeup_latency: -5293
> > > >
> > > > Looks like we missed a clock update on the cross cpu wakeup, Mike was
> > > > busy plugging those holes -- I've been starting at a patch that might
> > > > cure this (amongst other things).
> > >
> > > Hmm, current -tip should have that cured as per:
> >
> > well, but timestamp inconsistencies are still possible fundamentally, as
> > cpu_clock() is not globally serialized.
>
> No, but the cross-cpu update should have pulled 1 to the same time as 0.
>
> So what we see here is that at wakeup time, cpu0 has 01238.657997033, if
> it at that time does a cross-cpu clock update, sched_clock_remote()
> should pull cpu1's time to that same time (unless cpu1 is ahead, but
> given the situation that's clearly not the case).
>
> The clock update on cpu1's schedule() would then either find a negative
> increment, not further updating the time, but refreshing the raw tsc
> stamp so that future updates appear monotonic, or find a positive stamp,
> resulting in fwd time movement.
>
> In any case, the wakeup latency should appear >= 0.
To clarify, left to their own devices, cpu_clock() times are monotonic
per cpu, but can drift up to ~1 jiffy between cpus, but explicit
cross-cpu updates should pull them straight.
* Tom Zanussi <[email protected]> wrote:
> Hi,
>
> Here's a belated update to v1 of the trace stream scripting support
> patches I posted last month; I had meant to get this out sooner but
> got too busy with other things...
Excellent progress!
I wanted to try it so i took the patches and applied them with some
conflicts (they interacted with some other recent changes in perf), but
the Perl engine wouldnt build on Fedora 11 - see the errors attached
below.
I've pushed the merge out to this temporary branch:
git.kernel.org/pub/scm/linux/kernel/git/tip/linux-2.6-tip.git tmp.perf/scripting
Mind having a look at it?
Thanks,
Ingo
CC util/trace-event-perl.o
cc1: warnings being treated as errors
util/trace-event-perl.c: In function 'define_symbolic_value':
util/trace-event-perl.c:70: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c:85: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c: In function 'define_symbolic_field':
util/trace-event-perl.c:102: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c:115: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c: In function 'define_flag_value':
util/trace-event-perl.c:128: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c:143: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c: In function 'define_flag_field':
util/trace-event-perl.c:161: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c:175: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c: In function 'perl_process_event':
util/trace-event-perl.c:301: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
util/trace-event-perl.c:350: error: declaration of 'my_perl' shadows a global declaration
util/trace-event-perl.c:48: error: shadowed declaration is here
make: *** [util/trace-event-perl.o] Error 1
On Sat, 2009-11-28 at 10:14 +0100, Ingo Molnar wrote:
> * Tom Zanussi <[email protected]> wrote:
>
> > Hi,
> >
> > Here's a belated update to v1 of the trace stream scripting support
> > patches I posted last month; I had meant to get this out sooner but
> > got too busy with other things...
>
> Excellent progress!
>
> I wanted to try it so i took the patches and applied them with some
> conflicts (they interacted with some other recent changes in perf), but
> the Perl engine wouldnt build on Fedora 11 - see the errors attached
> below.
>
> I've pushed the merge out to this temporary branch:
>
> git.kernel.org/pub/scm/linux/kernel/git/tip/linux-2.6-tip.git tmp.perf/scripting
>
> Mind having a look at it?
>
Sure, I'll post a patch that fixes this for me on Fedora shortly - the
reason for the warnings is that the debugging versions of the Perl
macros used in trace-event-perl.c get pulled in in Fedora (I did 'yum
install perl-ExtUtils-Embed' to get the libperl support), and the
debugging code generated by them shadows a global variable. Since the
code should work in the debugging case regardless, and since I don't
have control over the code in the macros, I don't see much choice in
this case but to ignore the warning.
I'll also post a few other fixes for things I noticed when fixing this.
Tom
> Thanks,
>
> Ingo
>
> CC util/trace-event-perl.o
> cc1: warnings being treated as errors
> util/trace-event-perl.c: In function 'define_symbolic_value':
> util/trace-event-perl.c:70: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c:85: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c: In function 'define_symbolic_field':
> util/trace-event-perl.c:102: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c:115: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c: In function 'define_flag_value':
> util/trace-event-perl.c:128: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c:143: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c: In function 'define_flag_field':
> util/trace-event-perl.c:161: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c:175: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c: In function 'perl_process_event':
> util/trace-event-perl.c:301: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> util/trace-event-perl.c:350: error: declaration of 'my_perl' shadows a global declaration
> util/trace-event-perl.c:48: error: shadowed declaration is here
> make: *** [util/trace-event-perl.o] Error 1
Commit-ID: 956ffd027bedc4106b901eb6a50f0a6c6de4113d
Gitweb: http://git.kernel.org/tip/956ffd027bedc4106b901eb6a50f0a6c6de4113d
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:46 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:24 +0100
perf trace: Add scripting ops
Adds an interface, scripting_ops, that when implemented for a
particular scripting language enables built-in support for trace
stream processing using that language.
The interface is designed to enable full-fledged language
interpreters to be embedded inside the perf executable and
thereby make the full capabilities of the supported languages
available for trace processing.
See below for details on the interface.
This patch also adds a couple command-line options to 'perf
trace':
The -s option option is used to specify the script to be run.
Script names that can be used with -s take the form:
[language spec:]scriptname[.ext]
Scripting languages register a set of 'language specs' that can
be used to specify scripts for the registered languages. The
specs can be used either as prefixes or extensions.
If [language spec:] is used, the script is taken as a script of
the matching language regardless of any extension it might have.
If [language spec:] is not used, [.ext] is used to look up the
language it corresponds to. Language specs are case
insensitive.
e.g. Perl scripts can be specified in the following ways:
Perl:scriptname
pl:scriptname.py # extension ignored
PL:scriptname
scriptname.pl
scriptname.perl
The -g [language spec] option gives users an easy starting point
for writing scripts in the specified language. Scripting
support for a particular language can implement a
generate_script() scripting op that outputs an empty (or
near-empty) set of handlers for all the events contained in a
given perf.data trace file - this option gives users a direct
way to access that.
Adding support for a scripting language
---------------------------------------
The main thing that needs to be done do add support for a new
language is to implement the scripting_ops interface:
It consists of the following four functions:
start_script()
stop_script()
process_event()
generate_script()
start_script() is called before any events are processed, and is
meant to give the scripting language support an opportunity to
set things up to receive events e.g. create and initialize an
instance of a language interpreter.
stop_script() is called after all events are processed, and is
meant to give the scripting language support an opportunity to
clean up e.g. destroy the interpreter instance, etc.
process_event() is called once for each event and takes as its
main parameter a pointer to the binary trace event record to be
processed. The implementation is responsible for picking out the
binary fields from the event record and sending them to the
script handler function associated with that event e.g. a
function derived from the event name it's meant to handle e.g.
'sched::sched_switch()'. The 'format' information for trace
events can be used to parse the binary data and map it into a
form usable by a given scripting language; see the Perl
implemention in subsequent patches for one possible way to
leverage the existing trace format parsing code in perf and map
that info into specific scripting language types.
generate_script() should generate a ready-to-run script for the
current set of events in the trace, preferably with bodies that
print out every field for each event. Again, look at the Perl
implementation for clues as to how that can be done. This is an
optional, but very useful op.
Support for a given language should also add a language-specific
setup function and call it from setup_scripting(). The
language-specific setup function associates the the scripting
ops for that language with one or more 'language specifiers'
(see below) using script_spec_register(). When a script name is
specified on the command line, the scripting ops associated with
the specified language are used to instantiate and use the
appropriate interpreter to process the trace stream.
In general, it should be relatively easy to add support for a
new language, especially if the language implementation supports
an interface allowing an interpreter to be 'embedded' inside
another program (in this case the containing program will be
'perf trace'). If so, it should be relatively straightforward to
translate trace events into invocations of user-defined script
functions where e.g. the function name corresponds to the event
type and the function parameters correspond to the event fields.
The event and field type information exported by the event
tracing infrastructure (via the event 'format' files) should be
enough to parse and send any piece of trace data to the user
script. The easiest way to see how this can be done would be to
look at the Perl implementation contained in
perf/util/trace-event-perl.c/.h.
There are a couple of other things that aren't covered by the
scripting_ops or setup interface and are technically optional,
but should be implemented if possible. One of these is support
for 'flag' and 'symbolic' fields e.g. being able to use more
human-readable values such as 'GFP_KERNEL' or
HI/BLOCK_IOPOLL/TASKLET in place of raw flag values. See the
Perl implementation to see how this can be done. The other thing
is support for 'calling back' into the perf executable to access
e.g. uncommon fields not passed by default into handler
functions, or any metadata the implementation might want to make
available to users via the language interface. Again, see the
Perl implementation for examples.
Signed-off-by: Tom Zanussi <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
tools/perf/builtin-trace.c | 255 ++++++++++++++++++++++++++++++++++++++++-
tools/perf/util/trace-event.h | 11 ++
2 files changed, 261 insertions(+), 5 deletions(-)
diff --git a/tools/perf/builtin-trace.c b/tools/perf/builtin-trace.c
index a775025..e96bb53 100644
--- a/tools/perf/builtin-trace.c
+++ b/tools/perf/builtin-trace.c
@@ -6,6 +6,46 @@
#include "util/thread.h"
#include "util/header.h"
+static char const *script_name;
+static char const *generate_script_lang;
+
+static int default_start_script(const char *script __attribute((unused)))
+{
+ return 0;
+}
+
+static int default_stop_script(void)
+{
+ return 0;
+}
+
+static int default_generate_script(const char *outfile __attribute ((unused)))
+{
+ return 0;
+}
+
+static struct scripting_ops default_scripting_ops = {
+ .start_script = default_start_script,
+ .stop_script = default_stop_script,
+ .process_event = print_event,
+ .generate_script = default_generate_script,
+};
+
+static struct scripting_ops *scripting_ops;
+
+static void setup_scripting(void)
+{
+ /* make sure PERF_EXEC_PATH is set for scripts */
+ perf_set_argv_exec_path(perf_exec_path());
+
+ scripting_ops = &default_scripting_ops;
+}
+
+static int cleanup_scripting(void)
+{
+ return scripting_ops->stop_script();
+}
+
#include "util/parse-options.h"
#include "perf.h"
@@ -13,11 +53,12 @@
#include "util/trace-event.h"
#include "util/data_map.h"
+#include "util/exec_cmd.h"
-static char const *input_name = "perf.data";
+static char const *input_name = "perf.data";
-static struct perf_header *header;
-static u64 sample_type;
+static struct perf_header *header;
+static u64 sample_type;
static int process_sample_event(event_t *event)
{
@@ -69,7 +110,8 @@ static int process_sample_event(event_t *event)
* field, although it should be the same than this perf
* event pid
*/
- print_event(cpu, raw->data, raw->size, timestamp, thread->comm);
+ scripting_ops->process_event(cpu, raw->data, raw->size,
+ timestamp, thread->comm);
}
event__stats.total += period;
@@ -105,6 +147,154 @@ static int __cmd_trace(void)
0, 0, &event__cwdlen, &event__cwd);
}
+struct script_spec {
+ struct list_head node;
+ struct scripting_ops *ops;
+ char spec[0];
+};
+
+LIST_HEAD(script_specs);
+
+static struct script_spec *script_spec__new(const char *spec,
+ struct scripting_ops *ops)
+{
+ struct script_spec *s = malloc(sizeof(*s) + strlen(spec) + 1);
+
+ if (s != NULL) {
+ strcpy(s->spec, spec);
+ s->ops = ops;
+ }
+
+ return s;
+}
+
+static void script_spec__delete(struct script_spec *s)
+{
+ free(s->spec);
+ free(s);
+}
+
+static void script_spec__add(struct script_spec *s)
+{
+ list_add_tail(&s->node, &script_specs);
+}
+
+static struct script_spec *script_spec__find(const char *spec)
+{
+ struct script_spec *s;
+
+ list_for_each_entry(s, &script_specs, node)
+ if (strcasecmp(s->spec, spec) == 0)
+ return s;
+ return NULL;
+}
+
+static struct script_spec *script_spec__findnew(const char *spec,
+ struct scripting_ops *ops)
+{
+ struct script_spec *s = script_spec__find(spec);
+
+ if (s)
+ return s;
+
+ s = script_spec__new(spec, ops);
+ if (!s)
+ goto out_delete_spec;
+
+ script_spec__add(s);
+
+ return s;
+
+out_delete_spec:
+ script_spec__delete(s);
+
+ return NULL;
+}
+
+int script_spec_register(const char *spec, struct scripting_ops *ops)
+{
+ struct script_spec *s;
+
+ s = script_spec__find(spec);
+ if (s)
+ return -1;
+
+ s = script_spec__findnew(spec, ops);
+ if (!s)
+ return -1;
+
+ return 0;
+}
+
+static struct scripting_ops *script_spec__lookup(const char *spec)
+{
+ struct script_spec *s = script_spec__find(spec);
+ if (!s)
+ return NULL;
+
+ return s->ops;
+}
+
+static void list_available_languages(void)
+{
+ struct script_spec *s;
+
+ fprintf(stderr, "\n");
+ fprintf(stderr, "Scripting language extensions (used in "
+ "perf trace -s [spec:]script.[spec]):\n\n");
+
+ list_for_each_entry(s, &script_specs, node)
+ fprintf(stderr, " %-42s [%s]\n", s->spec, s->ops->name);
+
+ fprintf(stderr, "\n");
+}
+
+static int parse_scriptname(const struct option *opt __used,
+ const char *str, int unset __used)
+{
+ char spec[PATH_MAX];
+ const char *script, *ext;
+ int len;
+
+ if (strcmp(str, "list") == 0) {
+ list_available_languages();
+ return 0;
+ }
+
+ script = strchr(str, ':');
+ if (script) {
+ len = script - str;
+ if (len >= PATH_MAX) {
+ fprintf(stderr, "invalid language specifier");
+ return -1;
+ }
+ strncpy(spec, str, len);
+ spec[len] = '\0';
+ scripting_ops = script_spec__lookup(spec);
+ if (!scripting_ops) {
+ fprintf(stderr, "invalid language specifier");
+ return -1;
+ }
+ script++;
+ } else {
+ script = str;
+ ext = strchr(script, '.');
+ if (!ext) {
+ fprintf(stderr, "invalid script extension");
+ return -1;
+ }
+ scripting_ops = script_spec__lookup(++ext);
+ if (!scripting_ops) {
+ fprintf(stderr, "invalid script extension");
+ return -1;
+ }
+ }
+
+ script_name = strdup(script);
+
+ return 0;
+}
+
static const char * const annotate_usage[] = {
"perf trace [<options>] <command>",
NULL
@@ -117,13 +307,23 @@ static const struct option options[] = {
"be more verbose (show symbol address, etc)"),
OPT_BOOLEAN('l', "latency", &latency_format,
"show latency attributes (irqs/preemption disabled, etc)"),
+ OPT_CALLBACK('s', "script", NULL, "name",
+ "script file name (lang:script name, script name, or *)",
+ parse_scriptname),
+ OPT_STRING('g', "gen-script", &generate_script_lang, "lang",
+ "generate perf-trace.xx script in specified language"),
+
OPT_END()
};
int cmd_trace(int argc, const char **argv, const char *prefix __used)
{
+ int err;
+
symbol__init(0);
+ setup_scripting();
+
argc = parse_options(argc, argv, options, annotate_usage, 0);
if (argc) {
/*
@@ -136,5 +336,50 @@ int cmd_trace(int argc, const char **argv, const char *prefix __used)
setup_pager();
- return __cmd_trace();
+ if (generate_script_lang) {
+ struct stat perf_stat;
+
+ int input = open(input_name, O_RDONLY);
+ if (input < 0) {
+ perror("failed to open file");
+ exit(-1);
+ }
+
+ err = fstat(input, &perf_stat);
+ if (err < 0) {
+ perror("failed to stat file");
+ exit(-1);
+ }
+
+ if (!perf_stat.st_size) {
+ fprintf(stderr, "zero-sized file, nothing to do!\n");
+ exit(0);
+ }
+
+ scripting_ops = script_spec__lookup(generate_script_lang);
+ if (!scripting_ops) {
+ fprintf(stderr, "invalid language specifier");
+ return -1;
+ }
+
+ header = perf_header__new();
+ if (header == NULL)
+ return -1;
+
+ perf_header__read(header, input);
+ err = scripting_ops->generate_script("perf-trace");
+ goto out;
+ }
+
+ if (script_name) {
+ err = scripting_ops->start_script(script_name);
+ if (err)
+ goto out;
+ }
+
+ err = __cmd_trace();
+
+ cleanup_scripting();
+out:
+ return err;
}
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index dd51c68..e7aaf00 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -259,4 +259,15 @@ enum trace_flag_type {
TRACE_FLAG_SOFTIRQ = 0x10,
};
+struct scripting_ops {
+ const char *name;
+ int (*start_script) (const char *);
+ int (*stop_script) (void);
+ void (*process_event) (int cpu, void *data, int size,
+ unsigned long long nsecs, char *comm);
+ int (*generate_script) (const char *outfile);
+};
+
+int script_spec_register(const char *spec, struct scripting_ops *ops);
+
#endif /* __PERF_TRACE_EVENTS_H */
Commit-ID: eb9a42caa7a926beb935a22bc59d981b35f0b652
Gitweb: http://git.kernel.org/tip/eb9a42caa7a926beb935a22bc59d981b35f0b652
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:47 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:25 +0100
perf trace: Add flag/symbolic format_flags
It's useful to know whether a field is a flag or symbolic field
for e.g. when generating scripts - it allows us to translate
those fields specially rather than literally as plain numeric
values.
Signed-off-by: Tom Zanussi <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
tools/perf/util/trace-event-parse.c | 17 +++++++++++++++++
tools/perf/util/trace-event.h | 2 ++
2 files changed, 19 insertions(+), 0 deletions(-)
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index 7021dc1..85d7163 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -48,6 +48,11 @@ static unsigned long long input_buf_siz;
static int cpus;
static int long_size;
+static int is_flag_field;
+static int is_symbolic_field;
+
+static struct format_field *
+find_any_field(struct event *event, const char *name);
static void init_input_buf(char *buf, unsigned long long size)
{
@@ -1301,6 +1306,16 @@ process_entry(struct event *event __unused, struct print_arg *arg,
arg->type = PRINT_FIELD;
arg->field.name = field;
+ if (is_flag_field) {
+ arg->field.field = find_any_field(event, arg->field.name);
+ arg->field.field->flags |= FIELD_IS_FLAG;
+ is_flag_field = 0;
+ } else if (is_symbolic_field) {
+ arg->field.field = find_any_field(event, arg->field.name);
+ arg->field.field->flags |= FIELD_IS_SYMBOLIC;
+ is_symbolic_field = 0;
+ }
+
type = read_token(&token);
*tok = token;
@@ -1668,9 +1683,11 @@ process_arg_token(struct event *event, struct print_arg *arg,
type = process_entry(event, arg, &token);
} else if (strcmp(token, "__print_flags") == 0) {
free_token(token);
+ is_flag_field = 1;
type = process_flags(event, arg, &token);
} else if (strcmp(token, "__print_symbolic") == 0) {
free_token(token);
+ is_symbolic_field = 1;
type = process_symbols(event, arg, &token);
} else if (strcmp(token, "__get_str") == 0) {
free_token(token);
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index e7aaf00..aeb9157 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -29,6 +29,8 @@ enum format_flags {
FIELD_IS_SIGNED = 4,
FIELD_IS_STRING = 8,
FIELD_IS_DYNAMIC = 16,
+ FIELD_IS_FLAG = 32,
+ FIELD_IS_SYMBOLIC = 64,
};
struct format_field {
Commit-ID: 16c632de64a74644a46e7636db26b2cfb530ca13
Gitweb: http://git.kernel.org/tip/16c632de64a74644a46e7636db26b2cfb530ca13
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:48 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:26 +0100
perf trace: Add Perl scripting support
Implement trace_scripting_ops to make Perl a supported perf
trace scripting language.
Additionally adds code that allows Perl trace scripts to access
the 'flag' and 'symbolic' (__print_flags(), __print_symbolic())
field information parsed from the trace format files.
Also adds the Perl implementation of the generate_script()
trace_scripting_op, which creates a ready-to-run perf trace Perl
script based on existing trace data. Scripts generated by this
implementation print out all the fields for each event mentioned
in perf.data (and will detect and generate the proper scripting
code for 'flag' and 'symbolic' fields), and will additionally
generate handlers for the special 'trace_unhandled',
'trace_begin' and 'trace_end' handlers. Script authors can
simply remove the printing code to implement their own custom
event handling.
Signed-off-by: Tom Zanussi <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
tools/perf/Makefile | 13 +
tools/perf/builtin-trace.c | 2 +
tools/perf/util/trace-event-parse.c | 18 +-
tools/perf/util/trace-event-perl.c | 552 +++++++++++++++++++++++++++++++++++
tools/perf/util/trace-event-perl.h | 42 +++
tools/perf/util/trace-event.h | 7 +
6 files changed, 629 insertions(+), 5 deletions(-)
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index f1537a9..19e37cd 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -407,6 +407,7 @@ LIB_OBJS += util/thread.o
LIB_OBJS += util/trace-event-parse.o
LIB_OBJS += util/trace-event-read.o
LIB_OBJS += util/trace-event-info.o
+LIB_OBJS += util/trace-event-perl.o
LIB_OBJS += util/svghelper.o
LIB_OBJS += util/sort.o
LIB_OBJS += util/hist.o
@@ -489,6 +490,15 @@ else
LIB_OBJS += util/probe-finder.o
endif
+PERL_EMBED_LDOPTS = `perl -MExtUtils::Embed -e ldopts`
+PERL_EMBED_CCOPTS = `perl -MExtUtils::Embed -e ccopts`
+
+ifneq ($(shell sh -c "(echo '\#include <EXTERN.h>'; echo '\#include <perl.h>'; echo 'int main(void) { perl_alloc(); return 0; }') | $(CC) -x c - $(PERL_EMBED_CCOPTS) -o /dev/null $(PERL_EMBED_LDOPTS) > /dev/null 2>&1 && echo y"), y)
+ BASIC_CFLAGS += -DNO_LIBPERL
+else
+ ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
+endif
+
ifdef NO_DEMANGLE
BASIC_CFLAGS += -DNO_DEMANGLE
else
@@ -860,6 +870,9 @@ util/hweight.o: ../../lib/hweight.c PERF-CFLAGS
util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
$(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $<
+util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
+ $(QUIET_CC)$(CC) -o util/trace-event-perl.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter $<
+
perf-%$X: %.o $(PERFLIBS)
$(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
diff --git a/tools/perf/builtin-trace.c b/tools/perf/builtin-trace.c
index e96bb53..ca8ebf1 100644
--- a/tools/perf/builtin-trace.c
+++ b/tools/perf/builtin-trace.c
@@ -38,6 +38,8 @@ static void setup_scripting(void)
/* make sure PERF_EXEC_PATH is set for scripts */
perf_set_argv_exec_path(perf_exec_path());
+ setup_perl_scripting();
+
scripting_ops = &default_scripting_ops;
}
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index 85d7163..1f16495 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -1888,7 +1888,7 @@ find_any_field(struct event *event, const char *name)
return find_field(event, name);
}
-static unsigned long long read_size(void *ptr, int size)
+unsigned long long read_size(void *ptr, int size)
{
switch (size) {
case 1:
@@ -1973,7 +1973,7 @@ int trace_parse_common_type(void *data)
"common_type");
}
-static int parse_common_pid(void *data)
+int trace_parse_common_pid(void *data)
{
static int pid_offset;
static int pid_size;
@@ -2025,6 +2025,14 @@ struct event *trace_find_event(int id)
return event;
}
+struct event *trace_find_next_event(struct event *event)
+{
+ if (!event)
+ return event_list;
+
+ return event->next;
+}
+
static unsigned long long eval_num_arg(void *data, int size,
struct event *event, struct print_arg *arg)
{
@@ -2164,7 +2172,7 @@ static const struct flag flags[] = {
{ "HRTIMER_RESTART", 1 },
};
-static unsigned long long eval_flag(const char *flag)
+unsigned long long eval_flag(const char *flag)
{
int i;
@@ -2694,7 +2702,7 @@ get_return_for_leaf(int cpu, int cur_pid, unsigned long long cur_func,
if (!(event->flags & EVENT_FL_ISFUNCRET))
return NULL;
- pid = parse_common_pid(next->data);
+ pid = trace_parse_common_pid(next->data);
field = find_field(event, "func");
if (!field)
die("function return does not have field func");
@@ -2980,7 +2988,7 @@ void print_event(int cpu, void *data, int size, unsigned long long nsecs,
return;
}
- pid = parse_common_pid(data);
+ pid = trace_parse_common_pid(data);
if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET))
return pretty_print_func_graph(data, size, event, cpu,
diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c
new file mode 100644
index 0000000..c56b08d
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.c
@@ -0,0 +1,552 @@
+/*
+ * trace-event-perl. Feed perf trace events to an embedded Perl interpreter.
+ *
+ * Copyright (C) 2009 Tom Zanussi <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ */
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <ctype.h>
+#include <errno.h>
+
+#include "../perf.h"
+#include "util.h"
+#include "trace-event.h"
+#include "trace-event-perl.h"
+
+INTERP my_perl;
+
+#define FTRACE_MAX_EVENT \
+ ((1 << (sizeof(unsigned short) * 8)) - 1)
+
+struct event *events[FTRACE_MAX_EVENT];
+
+static struct scripting_context *scripting_context;
+
+static char *cur_field_name;
+static int zero_flag_atom;
+
+static void define_symbolic_value(const char *ev_name,
+ const char *field_name,
+ const char *field_value,
+ const char *field_str)
+{
+ unsigned long long value;
+ dSP;
+
+ value = eval_flag(field_value);
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+ XPUSHs(sv_2mortal(newSVuv(value)));
+ XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_symbolic_value", 0))
+ call_pv("main::define_symbolic_value", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_symbolic_values(struct print_flag_sym *field,
+ const char *ev_name,
+ const char *field_name)
+{
+ define_symbolic_value(ev_name, field_name, field->value, field->str);
+ if (field->next)
+ define_symbolic_values(field->next, ev_name, field_name);
+}
+
+static void define_symbolic_field(const char *ev_name,
+ const char *field_name)
+{
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_symbolic_field", 0))
+ call_pv("main::define_symbolic_field", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_flag_value(const char *ev_name,
+ const char *field_name,
+ const char *field_value,
+ const char *field_str)
+{
+ unsigned long long value;
+ dSP;
+
+ value = eval_flag(field_value);
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+ XPUSHs(sv_2mortal(newSVuv(value)));
+ XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_flag_value", 0))
+ call_pv("main::define_flag_value", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_flag_values(struct print_flag_sym *field,
+ const char *ev_name,
+ const char *field_name)
+{
+ define_flag_value(ev_name, field_name, field->value, field->str);
+ if (field->next)
+ define_flag_values(field->next, ev_name, field_name);
+}
+
+static void define_flag_field(const char *ev_name,
+ const char *field_name,
+ const char *delim)
+{
+ dSP;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
+ XPUSHs(sv_2mortal(newSVpv(delim, 0)));
+
+ PUTBACK;
+ if (get_cv("main::define_flag_field", 0))
+ call_pv("main::define_flag_field", G_SCALAR);
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void define_event_symbols(struct event *event,
+ const char *ev_name,
+ struct print_arg *args)
+{
+ switch (args->type) {
+ case PRINT_NULL:
+ break;
+ case PRINT_ATOM:
+ define_flag_value(ev_name, cur_field_name, "0",
+ args->atom.atom);
+ zero_flag_atom = 0;
+ break;
+ case PRINT_FIELD:
+ if (cur_field_name)
+ free(cur_field_name);
+ cur_field_name = strdup(args->field.name);
+ break;
+ case PRINT_FLAGS:
+ define_event_symbols(event, ev_name, args->flags.field);
+ define_flag_field(ev_name, cur_field_name, args->flags.delim);
+ define_flag_values(args->flags.flags, ev_name, cur_field_name);
+ break;
+ case PRINT_SYMBOL:
+ define_event_symbols(event, ev_name, args->symbol.field);
+ define_symbolic_field(ev_name, cur_field_name);
+ define_symbolic_values(args->symbol.symbols, ev_name,
+ cur_field_name);
+ break;
+ case PRINT_STRING:
+ break;
+ case PRINT_TYPE:
+ define_event_symbols(event, ev_name, args->typecast.item);
+ break;
+ case PRINT_OP:
+ if (strcmp(args->op.op, ":") == 0)
+ zero_flag_atom = 1;
+ define_event_symbols(event, ev_name, args->op.left);
+ define_event_symbols(event, ev_name, args->op.right);
+ break;
+ default:
+ /* we should warn... */
+ return;
+ }
+
+ if (args->next)
+ define_event_symbols(event, ev_name, args->next);
+}
+
+static inline struct event *find_cache_event(int type)
+{
+ static char ev_name[256];
+ struct event *event;
+
+ if (events[type])
+ return events[type];
+
+ events[type] = event = trace_find_event(type);
+ if (!event)
+ return NULL;
+
+ sprintf(ev_name, "%s::%s", event->system, event->name);
+
+ define_event_symbols(event, ev_name, event->print_fmt.args);
+
+ return event;
+}
+
+static void perl_process_event(int cpu, void *data,
+ int size __attribute((unused)),
+ unsigned long long nsecs, char *comm)
+{
+ struct format_field *field;
+ static char handler[256];
+ unsigned long long val;
+ unsigned long s, ns;
+ struct event *event;
+ int type;
+ int pid;
+
+ dSP;
+
+ type = trace_parse_common_type(data);
+
+ event = find_cache_event(type);
+ if (!event)
+ die("ug! no event found for type %d", type);
+
+ pid = trace_parse_common_pid(data);
+
+ sprintf(handler, "%s::%s", event->system, event->name);
+
+ s = nsecs / NSECS_PER_SEC;
+ ns = nsecs - s * NSECS_PER_SEC;
+
+ scripting_context->event_data = data;
+
+ ENTER;
+ SAVETMPS;
+ PUSHMARK(SP);
+
+ XPUSHs(sv_2mortal(newSVpv(handler, 0)));
+ XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
+ XPUSHs(sv_2mortal(newSVuv(cpu)));
+ XPUSHs(sv_2mortal(newSVuv(s)));
+ XPUSHs(sv_2mortal(newSVuv(ns)));
+ XPUSHs(sv_2mortal(newSViv(pid)));
+ XPUSHs(sv_2mortal(newSVpv(comm, 0)));
+
+ /* common fields other than pid can be accessed via xsub fns */
+
+ for (field = event->format.fields; field; field = field->next) {
+ if (field->flags & FIELD_IS_STRING) {
+ int offset;
+ if (field->flags & FIELD_IS_DYNAMIC) {
+ offset = *(int *)(data + field->offset);
+ offset &= 0xffff;
+ } else
+ offset = field->offset;
+ XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
+ } else { /* FIELD_IS_NUMERIC */
+ val = read_size(data + field->offset, field->size);
+ if (field->flags & FIELD_IS_SIGNED) {
+ XPUSHs(sv_2mortal(newSViv(val)));
+ } else {
+ XPUSHs(sv_2mortal(newSVuv(val)));
+ }
+ }
+ }
+
+ PUTBACK;
+ if (get_cv(handler, 0))
+ call_pv(handler, G_SCALAR);
+ else if (get_cv("main::trace_unhandled", 0)) {
+ XPUSHs(sv_2mortal(newSVpv(handler, 0)));
+ XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
+ XPUSHs(sv_2mortal(newSVuv(cpu)));
+ XPUSHs(sv_2mortal(newSVuv(nsecs)));
+ XPUSHs(sv_2mortal(newSViv(pid)));
+ XPUSHs(sv_2mortal(newSVpv(comm, 0)));
+ call_pv("main::trace_unhandled", G_SCALAR);
+ }
+ SPAGAIN;
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+}
+
+static void run_start_sub(void)
+{
+ dSP; /* access to Perl stack */
+ PUSHMARK(SP);
+
+ if (get_cv("main::trace_begin", 0))
+ call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
+}
+
+/*
+ * Start trace script
+ */
+static int perl_start_script(const char *script)
+{
+ const char *command_line[2] = { "", NULL };
+
+ command_line[1] = script;
+
+ my_perl = perl_alloc();
+ perl_construct(my_perl);
+
+ if (perl_parse(my_perl, NULL, 2, (char **)command_line, (char **)NULL))
+ return -1;
+
+ perl_run(my_perl);
+ if (SvTRUE(ERRSV))
+ return -1;
+
+ run_start_sub();
+
+ fprintf(stderr, "perf trace started with Perl script %s\n\n", script);
+
+ return 0;
+}
+
+/*
+ * Stop trace script
+ */
+static int perl_stop_script(void)
+{
+ dSP; /* access to Perl stack */
+ PUSHMARK(SP);
+
+ if (get_cv("main::trace_end", 0))
+ call_pv("main::trace_end", G_DISCARD | G_NOARGS);
+
+ perl_destruct(my_perl);
+ perl_free(my_perl);
+
+ fprintf(stderr, "\nperf trace Perl script stopped\n");
+
+ return 0;
+}
+
+static int perl_generate_script(const char *outfile)
+{
+ struct event *event = NULL;
+ struct format_field *f;
+ char fname[PATH_MAX];
+ int not_first, count;
+ FILE *ofp;
+
+ sprintf(fname, "%s.pl", outfile);
+ ofp = fopen(fname, "w");
+ if (ofp == NULL) {
+ fprintf(stderr, "couldn't open %s\n", fname);
+ return -1;
+ }
+
+ fprintf(ofp, "# perf trace event handlers, "
+ "generated by perf trace -g perl\n");
+
+ fprintf(ofp, "# Licensed under the terms of the GNU GPL"
+ " License version 2\n\n");
+
+ fprintf(ofp, "# The common_* event handler fields are the most useful "
+ "fields common to\n");
+
+ fprintf(ofp, "# all events. They don't necessarily correspond to "
+ "the 'common_*' fields\n");
+
+ fprintf(ofp, "# in the format files. Those fields not available as "
+ "handler params can\n");
+
+ fprintf(ofp, "# be retrieved using Perl functions of the form "
+ "common_*($context).\n");
+
+ fprintf(ofp, "# See Context.pm for the list of available "
+ "functions.\n\n");
+
+ fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
+ "Perf-Trace-Util/lib\";\n");
+
+ fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
+ fprintf(ofp, "use Perf::Trace::Core;\n");
+ fprintf(ofp, "use Perf::Trace::Context;\n");
+ fprintf(ofp, "use Perf::Trace::Util;\n\n");
+
+ fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
+ fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n");
+
+ while ((event = trace_find_next_event(event))) {
+ fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
+ fprintf(ofp, "\tmy (");
+
+ fprintf(ofp, "$event_name, ");
+ fprintf(ofp, "$context, ");
+ fprintf(ofp, "$common_cpu, ");
+ fprintf(ofp, "$common_secs, ");
+ fprintf(ofp, "$common_nsecs,\n");
+ fprintf(ofp, "\t $common_pid, ");
+ fprintf(ofp, "$common_comm,\n\t ");
+
+ not_first = 0;
+ count = 0;
+
+ for (f = event->format.fields; f; f = f->next) {
+ if (not_first++)
+ fprintf(ofp, ", ");
+ if (++count % 5 == 0)
+ fprintf(ofp, "\n\t ");
+
+ fprintf(ofp, "$%s", f->name);
+ }
+ fprintf(ofp, ") = @_;\n\n");
+
+ fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
+ "$common_secs, $common_nsecs,\n\t "
+ "$common_pid, $common_comm);\n\n");
+
+ fprintf(ofp, "\tprintf(\"");
+
+ not_first = 0;
+ count = 0;
+
+ for (f = event->format.fields; f; f = f->next) {
+ if (not_first++)
+ fprintf(ofp, ", ");
+ if (count && count % 4 == 0) {
+ fprintf(ofp, "\".\n\t \"");
+ }
+ count++;
+
+ fprintf(ofp, "%s=", f->name);
+ if (f->flags & FIELD_IS_STRING ||
+ f->flags & FIELD_IS_FLAG ||
+ f->flags & FIELD_IS_SYMBOLIC)
+ fprintf(ofp, "%%s");
+ else if (f->flags & FIELD_IS_SIGNED)
+ fprintf(ofp, "%%d");
+ else
+ fprintf(ofp, "%%u");
+ }
+
+ fprintf(ofp, "\\n\",\n\t ");
+
+ not_first = 0;
+ count = 0;
+
+ for (f = event->format.fields; f; f = f->next) {
+ if (not_first++)
+ fprintf(ofp, ", ");
+
+ if (++count % 5 == 0)
+ fprintf(ofp, "\n\t ");
+
+ if (f->flags & FIELD_IS_FLAG) {
+ if ((count - 1) % 5 != 0) {
+ fprintf(ofp, "\n\t ");
+ count = 4;
+ }
+ fprintf(ofp, "flag_str(\"");
+ fprintf(ofp, "%s::%s\", ", event->system,
+ event->name);
+ fprintf(ofp, "\"%s\", $%s)", f->name,
+ f->name);
+ } else if (f->flags & FIELD_IS_SYMBOLIC) {
+ if ((count - 1) % 5 != 0) {
+ fprintf(ofp, "\n\t ");
+ count = 4;
+ }
+ fprintf(ofp, "symbol_str(\"");
+ fprintf(ofp, "%s::%s\", ", event->system,
+ event->name);
+ fprintf(ofp, "\"%s\", $%s)", f->name,
+ f->name);
+ } else
+ fprintf(ofp, "$%s", f->name);
+ }
+
+ fprintf(ofp, ");\n");
+ fprintf(ofp, "}\n\n");
+ }
+
+ fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
+ "$common_cpu, $common_secs, $common_nsecs,\n\t "
+ "$common_pid, $common_comm) = @_;\n\n");
+
+ fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
+ "$common_secs, $common_nsecs,\n\t $common_pid, "
+ "$common_comm);\n}\n\n");
+
+ fprintf(ofp, "sub print_header\n{\n"
+ "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
+ "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t "
+ "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}");
+
+ fclose(ofp);
+
+ fprintf(stderr, "generated Perl script: %s\n", fname);
+
+ return 0;
+}
+
+struct scripting_ops perl_scripting_ops = {
+ .name = "Perl",
+ .start_script = perl_start_script,
+ .stop_script = perl_stop_script,
+ .process_event = perl_process_event,
+ .generate_script = perl_generate_script,
+};
+
+#ifdef NO_LIBPERL
+void setup_perl_scripting(void)
+{
+ fprintf(stderr, "Perl scripting not supported."
+ " Install libperl-dev[el] and rebuild perf to get it.\n");
+}
+#else
+void setup_perl_scripting(void)
+{
+ int err;
+ err = script_spec_register("Perl", &perl_scripting_ops);
+ if (err)
+ die("error registering Perl script extension");
+
+ err = script_spec_register("pl", &perl_scripting_ops);
+ if (err)
+ die("error registering pl script extension");
+
+ scripting_context = malloc(sizeof(struct scripting_context));
+}
+#endif
diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h
new file mode 100644
index 0000000..6c94fa9
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.h
@@ -0,0 +1,42 @@
+#ifndef __PERF_TRACE_EVENT_PERL_H
+#define __PERF_TRACE_EVENT_PERL_H
+#ifdef NO_LIBPERL
+typedef int INTERP;
+#define dSP
+#define ENTER
+#define SAVETMPS
+#define PUTBACK
+#define SPAGAIN
+#define FREETMPS
+#define LEAVE
+#define SP
+#define ERRSV
+#define G_SCALAR (0)
+#define G_DISCARD (0)
+#define G_NOARGS (0)
+#define PUSHMARK(a)
+#define SvTRUE(a) (0)
+#define XPUSHs(s)
+#define sv_2mortal(a)
+#define newSVpv(a,b)
+#define newSVuv(a)
+#define newSViv(a)
+#define get_cv(a,b) (0)
+#define call_pv(a,b) (0)
+#define perl_alloc() (0)
+#define perl_construct(a) (0)
+#define perl_parse(a,b,c,d,e) (0)
+#define perl_run(a) (0)
+#define perl_destruct(a) (0)
+#define perl_free(a) (0)
+#else
+#include <EXTERN.h>
+#include <perl.h>
+typedef PerlInterpreter * INTERP;
+#endif
+
+struct scripting_context {
+ void *event_data;
+};
+
+#endif /* __PERF_TRACE_EVENT_PERL_H */
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index aeb9157..b1e58d3 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -245,10 +245,14 @@ extern int latency_format;
int parse_header_page(char *buf, unsigned long size);
int trace_parse_common_type(void *data);
+int trace_parse_common_pid(void *data);
struct event *trace_find_event(int id);
+struct event *trace_find_next_event(struct event *event);
+unsigned long long read_size(void *ptr, int size);
unsigned long long
raw_field_value(struct event *event, const char *name, void *data);
void *raw_field_ptr(struct event *event, const char *name, void *data);
+unsigned long long eval_flag(const char *flag);
int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events);
@@ -272,4 +276,7 @@ struct scripting_ops {
int script_spec_register(const char *spec, struct scripting_ops *ops);
+extern struct scripting_ops perl_scripting_ops;
+void setup_perl_scripting(void);
+
#endif /* __PERF_TRACE_EVENTS_H */
Commit-ID: bcefe12eff5dca6fdfa94ed85e5bee66380d5cd9
Gitweb: http://git.kernel.org/tip/bcefe12eff5dca6fdfa94ed85e5bee66380d5cd9
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:49 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:26 +0100
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 <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
tools/perf/Makefile | 7 +
.../perf/scripts/perl/Perf-Trace-Util/Makefile.PL | 12 ++
tools/perf/scripts/perl/Perf-Trace-Util/README | 35 ++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | 157 ++++++++++++++++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm | 88 ++++++++++
tools/perf/scripts/perl/rw-by-file.pl | 105 ++++++++++++
tools/perf/scripts/perl/rw-by-pid.pl | 170 ++++++++++++++++++++
tools/perf/scripts/perl/wakeup-latency.pl | 103 ++++++++++++
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 19e37cd..efbc0e8 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -980,6 +980,13 @@ export perfexec_instdir
install: all
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'
$(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)'
+ $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
+ $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
+ $(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
+ $(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl'
+ $(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
+ $(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
+ $(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
ifdef BUILT_INS
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
$(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 0000000..b0de02e
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
@@ -0,0 +1,12 @@
+use 5.010000;
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+WriteMakefile(
+ NAME => 'Perf::Trace::Util',
+ VERSION_FROM => 'lib/Perf/Trace/Util.pm', # finds $VERSION
+ PREREQ_PM => {}, # e.g., Module::Name => 1.1
+ ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ (ABSTRACT_FROM => 'lib/Perf/Trace/Util.pm', # retrieve abstract from module
+ AUTHOR => 'Tom Zanussi <[email protected]>') : ()),
+);
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 0000000..0a58378
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/README
@@ -0,0 +1,35 @@
+Perf-Trace-Util version 0.01
+============================
+
+This module contains utility functions for use with perf trace.
+
+INSTALLATION
+
+Building perf with perf trace Perl scripting should install this
+module in the right place.
+
+You should make sure libperl is installed first e.g. apt-get install
+libperl-dev.
+
+DEPENDENCIES
+
+This module requires these other modules and libraries:
+
+ blah blah blah
+
+COPYRIGHT AND LICENCE
+
+Put the correct copyright and licence information here.
+
+Copyright (C) 2009 by Tom Zanussi <[email protected]>
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+
+
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 0000000..fd250fb
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm
@@ -0,0 +1,157 @@
+package Perf::Trace::Core;
+
+use 5.010000;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+define_flag_field define_flag_value flag_str dump_flag_fields
+define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
+);
+
+our $VERSION = '0.01';
+
+my %flag_fields;
+my %symbolic_fields;
+
+sub flag_str
+{
+ my ($event_name, $field_name, $value) = @_;
+
+ my $string;
+
+ if ($flag_fields{$event_name}{$field_name}) {
+ my $print_delim = 0;
+ foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
+ if (!$value && !$idx) {
+ $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
+ last;
+ }
+ if ($idx && ($value & $idx) == $idx) {
+ if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
+ $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
+ }
+ $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
+ $print_delim = 1;
+ $value &= ~$idx;
+ }
+ }
+ }
+
+ return $string;
+}
+
+sub define_flag_field
+{
+ my ($event_name, $field_name, $delim) = @_;
+
+ $flag_fields{$event_name}{$field_name}{"delim"} = $delim;
+}
+
+sub define_flag_value
+{
+ my ($event_name, $field_name, $value, $field_str) = @_;
+
+ $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
+}
+
+sub dump_flag_fields
+{
+ for my $event (keys %flag_fields) {
+ print "event $event:\n";
+ for my $field (keys %{$flag_fields{$event}}) {
+ print " field: $field:\n";
+ print " delim: $flag_fields{$event}{$field}{'delim'}\n";
+ foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
+ print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
+ }
+ }
+ }
+}
+
+sub symbol_str
+{
+ my ($event_name, $field_name, $value) = @_;
+
+ if ($symbolic_fields{$event_name}{$field_name}) {
+ foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
+ if (!$value && !$idx) {
+ return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
+ last;
+ }
+ if ($value == $idx) {
+ return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
+ }
+ }
+ }
+
+ return undef;
+}
+
+sub define_symbolic_field
+{
+ my ($event_name, $field_name) = @_;
+
+ # nothing to do, really
+}
+
+sub define_symbolic_value
+{
+ my ($event_name, $field_name, $value, $field_str) = @_;
+
+ $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
+}
+
+sub dump_symbolic_fields
+{
+ for my $event (keys %symbolic_fields) {
+ print "event $event:\n";
+ for my $field (keys %{$symbolic_fields{$event}}) {
+ print " field: $field:\n";
+ foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
+ print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
+ }
+ }
+ }
+}
+
+1;
+__END__
+=head1 NAME
+
+Perf::Trace::Core - Perl extension for perf trace
+
+=head1 SYNOPSIS
+
+ use Perf::Trace::Core
+
+=head1 SEE ALSO
+
+Perf (trace) documentation
+
+=head1 AUTHOR
+
+Tom Zanussi, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Tom Zanussi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+=cut
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 0000000..052f132
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
@@ -0,0 +1,88 @@
+package Perf::Trace::Util;
+
+use 5.010000;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs
+);
+
+our $VERSION = '0.01';
+
+sub avg
+{
+ my ($total, $n) = @_;
+
+ return $total / $n;
+}
+
+my $NSECS_PER_SEC = 1000000000;
+
+sub nsecs
+{
+ my ($secs, $nsecs) = @_;
+
+ return $secs * $NSECS_PER_SEC + $nsecs;
+}
+
+sub nsecs_secs {
+ my ($nsecs) = @_;
+
+ return $nsecs / $NSECS_PER_SEC;
+}
+
+sub nsecs_nsecs {
+ my ($nsecs) = @_;
+
+ return $nsecs - nsecs_secs($nsecs);
+}
+
+sub nsecs_str {
+ my ($nsecs) = @_;
+
+ my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));
+
+ return $str;
+}
+
+1;
+__END__
+=head1 NAME
+
+Perf::Trace::Util - Perl extension for perf trace
+
+=head1 SYNOPSIS
+
+ use Perf::Trace::Util;
+
+=head1 SEE ALSO
+
+Perf (trace) documentation
+
+=head1 AUTHOR
+
+Tom Zanussi, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Tom Zanussi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+=cut
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 0000000..61f9156
--- /dev/null
+++ b/tools/perf/scripts/perl/rw-by-file.pl
@@ -0,0 +1,105 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Display r/w activity for files read/written to for a given program
+
+# The common_* event handler fields are the most useful fields common to
+# all events. They don't necessarily correspond to the 'common_*' fields
+# in the status files. Those fields not available as handler params can
+# be retrieved via script functions of the form get_common_*().
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+# change this to the comm of the program you're interested in
+my $for_comm = "perf";
+
+my %reads;
+my %writes;
+
+sub syscalls::sys_enter_read
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
+
+ if ($common_comm eq $for_comm) {
+ $reads{$fd}{bytes_requested} += $count;
+ $reads{$fd}{total_reads}++;
+ }
+}
+
+sub syscalls::sys_enter_write
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
+
+ if ($common_comm eq $for_comm) {
+ $writes{$fd}{bytes_written} += $count;
+ $writes{$fd}{total_writes}++;
+ }
+}
+
+sub trace_end
+{
+ printf("file read counts for $for_comm:\n\n");
+
+ printf("%6s %10s %10s\n", "fd", "# reads", "bytes_requested");
+ printf("%6s %10s %10s\n", "------", "----------", "-----------");
+
+ foreach my $fd (sort {$reads{$b}{bytes_requested} <=>
+ $reads{$a}{bytes_requested}} keys %reads) {
+ my $total_reads = $reads{$fd}{total_reads};
+ my $bytes_requested = $reads{$fd}{bytes_requested};
+ printf("%6u %10u %10u\n", $fd, $total_reads, $bytes_requested);
+ }
+
+ printf("\nfile write counts for $for_comm:\n\n");
+
+ printf("%6s %10s %10s\n", "fd", "# writes", "bytes_written");
+ printf("%6s %10s %10s\n", "------", "----------", "-----------");
+
+ foreach my $fd (sort {$writes{$b}{bytes_written} <=>
+ $writes{$a}{bytes_written}} keys %writes) {
+ my $total_writes = $writes{$fd}{total_writes};
+ my $bytes_written = $writes{$fd}{bytes_written};
+ printf("%6u %10u %10u\n", $fd, $total_writes, $bytes_written);
+ }
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
+
+
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 0000000..da601fa
--- /dev/null
+++ b/tools/perf/scripts/perl/rw-by-pid.pl
@@ -0,0 +1,170 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Display r/w activity for all processes
+
+# The common_* event handler fields are the most useful fields common to
+# all events. They don't necessarily correspond to the 'common_*' fields
+# in the status files. Those fields not available as handler params can
+# be retrieved via script functions of the form get_common_*().
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+my %reads;
+my %writes;
+
+sub syscalls::sys_exit_read
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $ret) = @_;
+
+ if ($ret > 0) {
+ $reads{$common_pid}{bytes_read} += $ret;
+ } else {
+ if (!defined ($reads{$common_pid}{bytes_read})) {
+ $reads{$common_pid}{bytes_read} = 0;
+ }
+ $reads{$common_pid}{errors}{$ret}++;
+ }
+}
+
+sub syscalls::sys_enter_read
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $fd, $buf, $count) = @_;
+
+ $reads{$common_pid}{bytes_requested} += $count;
+ $reads{$common_pid}{total_reads}++;
+ $reads{$common_pid}{comm} = $common_comm;
+}
+
+sub syscalls::sys_exit_write
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $ret) = @_;
+
+ if ($ret <= 0) {
+ $writes{$common_pid}{errors}{$ret}++;
+ }
+}
+
+sub syscalls::sys_enter_write
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $nr, $fd, $buf, $count) = @_;
+
+ $writes{$common_pid}{bytes_written} += $count;
+ $writes{$common_pid}{total_writes}++;
+ $writes{$common_pid}{comm} = $common_comm;
+}
+
+sub trace_end
+{
+ printf("read counts by pid:\n\n");
+
+ printf("%6s %20s %10s %10s %10s\n", "pid", "comm",
+ "# reads", "bytes_requested", "bytes_read");
+ printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------",
+ "-----------", "----------", "----------");
+
+ foreach my $pid (sort {$reads{$b}{bytes_read} <=>
+ $reads{$a}{bytes_read}} keys %reads) {
+ my $comm = $reads{$pid}{comm};
+ my $total_reads = $reads{$pid}{total_reads};
+ my $bytes_requested = $reads{$pid}{bytes_requested};
+ my $bytes_read = $reads{$pid}{bytes_read};
+
+ printf("%6s %-20s %10s %10s %10s\n", $pid, $comm,
+ $total_reads, $bytes_requested, $bytes_read);
+ }
+
+ printf("\nfailed reads by pid:\n\n");
+
+ printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
+ printf("%6s %20s %6s %10s\n", "------", "--------------------",
+ "------", "----------");
+
+ foreach my $pid (keys %reads) {
+ my $comm = $reads{$pid}{comm};
+ foreach my $err (sort {$reads{$b}{comm} cmp $reads{$a}{comm}}
+ keys %{$reads{$pid}{errors}}) {
+ my $errors = $reads{$pid}{errors}{$err};
+
+ printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
+ }
+ }
+
+ printf("\nwrite counts by pid:\n\n");
+
+ printf("%6s %20s %10s %10s\n", "pid", "comm",
+ "# writes", "bytes_written");
+ printf("%6s %-20s %10s %10s\n", "------", "--------------------",
+ "-----------", "----------");
+
+ foreach my $pid (sort {$writes{$b}{bytes_written} <=>
+ $writes{$a}{bytes_written}} keys %writes) {
+ my $comm = $writes{$pid}{comm};
+ my $total_writes = $writes{$pid}{total_writes};
+ my $bytes_written = $writes{$pid}{bytes_written};
+
+ printf("%6s %-20s %10s %10s\n", $pid, $comm,
+ $total_writes, $bytes_written);
+ }
+
+ printf("\nfailed writes by pid:\n\n");
+
+ printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
+ printf("%6s %20s %6s %10s\n", "------", "--------------------",
+ "------", "----------");
+
+ foreach my $pid (keys %writes) {
+ my $comm = $writes{$pid}{comm};
+ foreach my $err (sort {$writes{$b}{comm} cmp $writes{$a}{comm}}
+ keys %{$writes{$pid}{errors}}) {
+ my $errors = $writes{$pid}{errors}{$err};
+
+ printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
+ }
+ }
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
diff --git a/tools/perf/scripts/perl/wakeup-latency.pl b/tools/perf/scripts/perl/wakeup-latency.pl
new file mode 100644
index 0000000..ed58ef2
--- /dev/null
+++ b/tools/perf/scripts/perl/wakeup-latency.pl
@@ -0,0 +1,103 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Display avg/min/max wakeup latency
+
+# The common_* event handler fields are the most useful fields common to
+# all events. They don't necessarily correspond to the 'common_*' fields
+# in the status files. Those fields not available as handler params can
+# be retrieved via script functions of the form get_common_*().
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+my %last_wakeup;
+
+my $max_wakeup_latency;
+my $min_wakeup_latency;
+my $total_wakeup_latency;
+my $total_wakeups;
+
+sub sched::sched_switch
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid,
+ $next_prio) = @_;
+
+ my $wakeup_ts = $last_wakeup{$common_cpu}{ts};
+ if ($wakeup_ts) {
+ my $switch_ts = nsecs($common_secs, $common_nsecs);
+ my $wakeup_latency = $switch_ts - $wakeup_ts;
+ if ($wakeup_latency > $max_wakeup_latency) {
+ $max_wakeup_latency = $wakeup_latency;
+ }
+ if ($wakeup_latency < $min_wakeup_latency) {
+ $min_wakeup_latency = $wakeup_latency;
+ }
+ $total_wakeup_latency += $wakeup_latency;
+ $total_wakeups++;
+ }
+ $last_wakeup{$common_cpu}{ts} = 0;
+}
+
+sub sched::sched_wakeup
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $comm, $pid, $prio, $success, $target_cpu) = @_;
+
+ $last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs);
+}
+
+sub trace_begin
+{
+ $min_wakeup_latency = 1000000000;
+ $max_wakeup_latency = 0;
+}
+
+sub trace_end
+{
+ printf("wakeup_latency stats:\n\n");
+ print "total_wakeups: $total_wakeups\n";
+ printf("avg_wakeup_latency (ns): %u\n",
+ avg($total_wakeup_latency, $total_wakeups));
+ printf("min_wakeup_latency (ns): %u\n", $min_wakeup_latency);
+ printf("max_wakeup_latency (ns): %u\n", $max_wakeup_latency);
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
diff --git a/tools/perf/scripts/perl/workqueue-stats.pl b/tools/perf/scripts/perl/workqueue-stats.pl
new file mode 100644
index 0000000..511302c
--- /dev/null
+++ b/tools/perf/scripts/perl/workqueue-stats.pl
@@ -0,0 +1,129 @@
+#!/usr/bin/perl -w
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# Displays workqueue stats
+#
+# Usage:
+#
+# perf record -c 1 -f -a -R -e workqueue:workqueue_creation -e
+# workqueue:workqueue_destruction -e workqueue:workqueue_execution
+# -e workqueue:workqueue_insertion
+#
+# perf trace -p -s tools/perf/scripts/perl/workqueue-stats.pl
+
+use 5.010000;
+use strict;
+use warnings;
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Util;
+
+my @cpus;
+
+sub workqueue::workqueue_destruction
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{destroyed}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub workqueue::workqueue_creation
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid, $cpu) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{created}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub workqueue::workqueue_execution
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid, $func) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{executed}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub workqueue::workqueue_insertion
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $thread_comm, $thread_pid, $func) = @_;
+
+ $cpus[$common_cpu]{$thread_pid}{inserted}++;
+ $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
+}
+
+sub trace_end
+{
+ print "workqueue work stats:\n\n";
+ my $cpu = 0;
+ printf("%3s %6s %6s\t%-20s\n", "cpu", "ins", "exec", "name");
+ printf("%3s %6s %6s\t%-20s\n", "---", "---", "----", "----");
+ foreach my $pidhash (@cpus) {
+ while ((my $pid, my $wqhash) = each %$pidhash) {
+ my $ins = $$wqhash{'inserted'};
+ my $exe = $$wqhash{'executed'};
+ my $comm = $$wqhash{'comm'};
+ if ($ins || $exe) {
+ printf("%3u %6u %6u\t%-20s\n", $cpu, $ins, $exe, $comm);
+ }
+ }
+ $cpu++;
+ }
+
+ $cpu = 0;
+ print "\nworkqueue lifecycle stats:\n\n";
+ printf("%3s %6s %6s\t%-20s\n", "cpu", "created", "destroyed", "name");
+ printf("%3s %6s %6s\t%-20s\n", "---", "-------", "---------", "----");
+ foreach my $pidhash (@cpus) {
+ while ((my $pid, my $wqhash) = each %$pidhash) {
+ my $created = $$wqhash{'created'};
+ my $destroyed = $$wqhash{'destroyed'};
+ my $comm = $$wqhash{'comm'};
+ if ($created || $destroyed) {
+ printf("%3u %6u %6u\t%-20s\n", $cpu, $created, $destroyed,
+ $comm);
+ }
+ }
+ $cpu++;
+ }
+
+ print_unhandled();
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
Commit-ID: d1b93772be78486397693fc39d3ddea3fda90105
Gitweb: http://git.kernel.org/tip/d1b93772be78486397693fc39d3ddea3fda90105
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:50 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:27 +0100
perf trace: Add interface to access perf data from Perl handlers
The Perl scripting support for perf trace allows most of a trace
event's data to be accessed directly as handler arguments, but
not all of it e.g. the less common fields aren't passed in. To
give scripts access to the other fields and/or any other data or
metadata in the main perf executable that might be useful, a way
to access the C data in perf from Perl is needed; this patch
uses the Perl XS facility to do it for the common_xxx event
fields not passed to handler functions.
Context.pm exports three functions to Perl scripts that access
fields for the current event by calling back into perf:
common_pc(), common_flags() and common_lock_depth(). Support
for common_flags() field values was added to Core.pm and a
script used to sanity check these and other basic scripting
features, check-perf-trace.pl, was also added.
Signed-off-by: Tom Zanussi <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
tools/perf/Makefile | 6 +-
tools/perf/scripts/perl/Perf-Trace-Util/Context.c | 134 ++++++++++++++++++++
tools/perf/scripts/perl/Perf-Trace-Util/Context.xs | 41 ++++++
.../perf/scripts/perl/Perf-Trace-Util/Makefile.PL | 11 ++-
tools/perf/scripts/perl/Perf-Trace-Util/README | 34 +++++-
.../perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm | 55 ++++++++
.../perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm | 35 +++++
tools/perf/scripts/perl/Perf-Trace-Util/typemap | 1 +
tools/perf/scripts/perl/check-perf-trace.pl | 106 ++++++++++++++++
tools/perf/util/trace-event-parse.c | 6 +-
tools/perf/util/trace-event-perl.c | 46 +++++++-
tools/perf/util/trace-event-perl.h | 9 ++
tools/perf/util/trace-event.h | 3 +
13 files changed, 474 insertions(+), 13 deletions(-)
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index efbc0e8..8ad57b5 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -497,6 +497,7 @@ ifneq ($(shell sh -c "(echo '\#include <EXTERN.h>'; echo '\#include <perl.h>'; e
BASIC_CFLAGS += -DNO_LIBPERL
else
ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
+ LIB_OBJS += scripts/perl/Perf-Trace-Util/Context.o
endif
ifdef NO_DEMANGLE
@@ -873,6 +874,9 @@ util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
$(QUIET_CC)$(CC) -o util/trace-event-perl.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter $<
+scripts/perl/Perf-Trace-Util/Context.o: scripts/perl/Perf-Trace-Util/Context.c PERF-CFLAGS
+ $(QUIET_CC)$(CC) -o scripts/perl/Perf-Trace-Util/Context.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter -Wno-nested-externs $<
+
perf-%$X: %.o $(PERFLIBS)
$(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
@@ -1072,7 +1076,7 @@ distclean: clean
# $(RM) configure
clean:
- $(RM) *.o */*.o $(LIB_FILE)
+ $(RM) *.o */*.o */*/*.o */*/*/*.o $(LIB_FILE)
$(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X
$(RM) $(TEST_PROGRAMS)
$(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope*
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 0000000..3ba3ffc
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
@@ -0,0 +1,134 @@
+/*
+ * This file was generated automatically by ExtUtils::ParseXS version 2.18_02 from the
+ * contents of Context.xs. Do not edit this file, edit Context.xs instead.
+ *
+ * ANY CHANGES MADE HERE WILL BE LOST!
+ *
+ */
+
+#line 1 "Context.xs"
+/*
+ * Context.xs. XS interfaces for perf trace.
+ *
+ * Copyright (C) 2009 Tom Zanussi <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "../../../util/trace-event-perl.h"
+
+#ifndef PERL_UNUSED_VAR
+# define PERL_UNUSED_VAR(var) if (0) var = var
+#endif
+
+#line 41 "Context.c"
+
+XS(XS_Perf__Trace__Context_get_common_pc); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_common_pc)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ if (items != 1)
+ Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_pc", "context");
+ PERL_UNUSED_VAR(cv); /* -W */
+ {
+ struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
+ int RETVAL;
+ dXSTARG;
+
+ RETVAL = get_common_pc(context);
+ XSprePUSH; PUSHi((IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+
+XS(XS_Perf__Trace__Context_get_common_flags); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_common_flags)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ if (items != 1)
+ Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_flags", "context");
+ PERL_UNUSED_VAR(cv); /* -W */
+ {
+ struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
+ int RETVAL;
+ dXSTARG;
+
+ RETVAL = get_common_flags(context);
+ XSprePUSH; PUSHi((IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+
+XS(XS_Perf__Trace__Context_get_common_lock_depth); /* prototype to pass -Wmissing-prototypes */
+XS(XS_Perf__Trace__Context_get_common_lock_depth)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ if (items != 1)
+ Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_lock_depth", "context");
+ PERL_UNUSED_VAR(cv); /* -W */
+ {
+ struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
+ int RETVAL;
+ dXSTARG;
+
+ RETVAL = get_common_lock_depth(context);
+ XSprePUSH; PUSHi((IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+#ifdef __cplusplus
+extern "C"
+#endif
+XS(boot_Perf__Trace__Context); /* prototype to pass -Wmissing-prototypes */
+XS(boot_Perf__Trace__Context)
+{
+#ifdef dVAR
+ dVAR; dXSARGS;
+#else
+ dXSARGS;
+#endif
+ const char* file = __FILE__;
+
+ PERL_UNUSED_VAR(cv); /* -W */
+ PERL_UNUSED_VAR(items); /* -W */
+ XS_VERSION_BOOTCHECK ;
+
+ newXSproto("Perf::Trace::Context::get_common_pc", XS_Perf__Trace__Context_get_common_pc, file, "$");
+ newXSproto("Perf::Trace::Context::get_common_flags", XS_Perf__Trace__Context_get_common_flags, file, "$");
+ newXSproto("Perf::Trace::Context::get_common_lock_depth", XS_Perf__Trace__Context_get_common_lock_depth, file, "$");
+ if (PL_unitcheckav)
+ call_list(PL_scopestack_ix, PL_unitcheckav);
+ XSRETURN_YES;
+}
+
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 0000000..24facb3
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
@@ -0,0 +1,41 @@
+/*
+ * Context.xs. XS interfaces for perf trace.
+ *
+ * Copyright (C) 2009 Tom Zanussi <[email protected]>
+ *
+ * This program is free software; you can redistribute it and/or modify
+ * it under the terms of the GNU General Public License as published by
+ * the Free Software Foundation; either version 2 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+ *
+ */
+
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include "../../../util/trace-event-perl.h"
+
+MODULE = Perf::Trace::Context PACKAGE = Perf::Trace::Context
+PROTOTYPES: ENABLE
+
+int
+get_common_pc(context)
+ struct scripting_context * context
+
+int
+get_common_flags(context)
+ struct scripting_context * context
+
+int
+get_common_lock_depth(context)
+ struct scripting_context * context
+
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
index b0de02e..decdeb0 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
@@ -3,10 +3,15 @@ use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
- NAME => 'Perf::Trace::Util',
- VERSION_FROM => 'lib/Perf/Trace/Util.pm', # finds $VERSION
+ NAME => 'Perf::Trace::Context',
+ VERSION_FROM => 'lib/Perf/Trace/Context.pm', # finds $VERSION
PREREQ_PM => {}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'lib/Perf/Trace/Util.pm', # retrieve abstract from module
+ (ABSTRACT_FROM => 'lib/Perf/Trace/Context.pm', # retrieve abstract from module
AUTHOR => 'Tom Zanussi <[email protected]>') : ()),
+ LIBS => [''], # e.g., '-lm'
+ DEFINE => '-I ../..', # e.g., '-DHAVE_SOMETHING'
+ INC => '-I.', # e.g., '-I. -I/usr/include/other'
+ # Un-comment this if you add C files to link with later:
+ OBJECT => 'Context.o', # link all the C files too
);
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/README b/tools/perf/scripts/perl/Perf-Trace-Util/README
index 0a58378..adb99aa 100644
--- a/tools/perf/scripts/perl/Perf-Trace-Util/README
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/README
@@ -3,6 +3,34 @@ Perf-Trace-Util version 0.01
This module contains utility functions for use with perf trace.
+Core.pm and Util.pm are pure Perl modules; Core.pm contains routines
+that the core perf support for Perl calls on and should always be
+'used', while Util.pm contains useful but optional utility functions
+that scripts may want to use. Context.pm contains the Perl->C
+interface that allows scripts to access data in the embedding perf
+executable; scripts wishing to do that should 'use Context.pm'.
+
+The Perl->C perf interface is completely driven by Context.xs. If you
+want to add new Perl functions that end up accessing C data in the
+perf executable, you add desciptions of the new functions here.
+scripting_context is a pointer to the perf data in the perf executable
+that you want to access - it's passed as the second parameter,
+$context, to all handler functions.
+
+After you do that:
+
+ perl Makefile.PL # to create a Makefile for the next step
+ make # to create Context.c
+
+ edit Context.c to add const to the char* file = __FILE__ line in
+ XS(boot_Perf__Trace__Context) to silence a warning/error.
+
+ You can delete the Makefile, object files and anything else that was
+ generated e.g. blib and shared library, etc, except for of course
+ Context.c
+
+ You should then be able to run the normal perf make as usual.
+
INSTALLATION
Building perf with perf trace Perl scripting should install this
@@ -15,12 +43,10 @@ DEPENDENCIES
This module requires these other modules and libraries:
- blah blah blah
+ None
COPYRIGHT AND LICENCE
-Put the correct copyright and licence information here.
-
Copyright (C) 2009 by Tom Zanussi <[email protected]>
This library is free software; you can redistribute it and/or modify
@@ -31,5 +57,3 @@ Alternatively, this software may be distributed under the terms of the
GNU General Public License ("GPL") version 2 as published by the Free
Software Foundation.
-
-
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 0000000..6c7f365
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
@@ -0,0 +1,55 @@
+package Perf::Trace::Context;
+
+use 5.010000;
+use strict;
+use warnings;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our %EXPORT_TAGS = ( 'all' => [ qw(
+) ] );
+
+our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
+
+our @EXPORT = qw(
+ common_pc common_flags common_lock_depth
+);
+
+our $VERSION = '0.01';
+
+require XSLoader;
+XSLoader::load('Perf::Trace::Context', $VERSION);
+
+1;
+__END__
+=head1 NAME
+
+Perf::Trace::Context - Perl extension for accessing functions in perf.
+
+=head1 SYNOPSIS
+
+ use Perf::Trace::Context;
+
+=head1 SEE ALSO
+
+Perf (trace) documentation
+
+=head1 AUTHOR
+
+Tom Zanussi, E<lt>[email protected]<gt>
+
+=head1 COPYRIGHT AND LICENSE
+
+Copyright (C) 2009 by Tom Zanussi
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.10.0 or,
+at your option, any later version of Perl 5 you may have available.
+
+Alternatively, this software may be distributed under the terms of the
+GNU General Public License ("GPL") version 2 as published by the Free
+Software Foundation.
+
+=cut
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
index fd250fb..9df376a 100644
--- 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
@@ -16,10 +16,45 @@ our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw(
define_flag_field define_flag_value flag_str dump_flag_fields
define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
+trace_flag_str
);
our $VERSION = '0.01';
+my %trace_flags = (0x00 => "NONE",
+ 0x01 => "IRQS_OFF",
+ 0x02 => "IRQS_NOSUPPORT",
+ 0x04 => "NEED_RESCHED",
+ 0x08 => "HARDIRQ",
+ 0x10 => "SOFTIRQ");
+
+sub trace_flag_str
+{
+ my ($value) = @_;
+
+ my $string;
+
+ my $print_delim = 0;
+
+ foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
+ if (!$value && !$idx) {
+ $string .= "NONE";
+ last;
+ }
+
+ if ($idx && ($value & $idx) == $idx) {
+ if ($print_delim) {
+ $string .= " | ";
+ }
+ $string .= "$trace_flags{$idx}";
+ $print_delim = 1;
+ $value &= ~$idx;
+ }
+ }
+
+ return $string;
+}
+
my %flag_fields;
my %symbolic_fields;
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 0000000..8408368
--- /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/check-perf-trace.pl b/tools/perf/scripts/perl/check-perf-trace.pl
new file mode 100644
index 0000000..4e7dc0a
--- /dev/null
+++ b/tools/perf/scripts/perl/check-perf-trace.pl
@@ -0,0 +1,106 @@
+# perf trace event handlers, generated by perf trace -g perl
+# (c) 2009, Tom Zanussi <[email protected]>
+# Licensed under the terms of the GNU GPL License version 2
+
+# This script tests basic functionality such as flag and symbol
+# strings, common_xxx() calls back into perf, begin, end, unhandled
+# events, etc. Basically, if this script runs successfully and
+# displays expected results, perl scripting support should be ok.
+
+use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+use lib "./Perf-Trace-Util/lib";
+use Perf::Trace::Core;
+use Perf::Trace::Context;
+use Perf::Trace::Util;
+
+sub trace_begin
+{
+ print "trace_begin\n";
+}
+
+sub trace_end
+{
+ print "trace_end\n";
+
+ print_unhandled();
+}
+
+sub irq::softirq_entry
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $vec) = @_;
+
+ print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm);
+
+ print_uncommon($context);
+
+ printf("vec=%s\n",
+ symbol_str("irq::softirq_entry", "vec", $vec));
+}
+
+sub kmem::kmalloc
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm,
+ $call_site, $ptr, $bytes_req, $bytes_alloc,
+ $gfp_flags) = @_;
+
+ print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm);
+
+ print_uncommon($context);
+
+ printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
+ "gfp_flags=%s\n",
+ $call_site, $ptr, $bytes_req, $bytes_alloc,
+
+ flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
+}
+
+# print trace fields not included in handler args
+sub print_uncommon
+{
+ my ($context) = @_;
+
+ printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
+ common_pc($context), trace_flag_str(common_flags($context)),
+ common_lock_depth($context));
+
+}
+
+my %unhandled;
+
+sub print_unhandled
+{
+ if ((scalar keys %unhandled) == 0) {
+ return;
+ }
+
+ print "\nunhandled events:\n\n";
+
+ printf("%-40s %10s\n", "event", "count");
+ printf("%-40s %10s\n", "----------------------------------------",
+ "-----------");
+
+ foreach my $event_name (keys %unhandled) {
+ printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
+ }
+}
+
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
+ $common_pid, $common_comm) = @_;
+
+ $unhandled{$event_name}++;
+}
+
+sub print_header
+{
+ my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
+
+ printf("%-20s %5u %05u.%09u %8u %-20s ",
+ $event_name, $cpu, $secs, $nsecs, $pid, $comm);
+}
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index 1f16495..0302405 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -1982,7 +1982,7 @@ int trace_parse_common_pid(void *data)
"common_pid");
}
-static int parse_common_pc(void *data)
+int parse_common_pc(void *data)
{
static int pc_offset;
static int pc_size;
@@ -1991,7 +1991,7 @@ static int parse_common_pc(void *data)
"common_preempt_count");
}
-static int parse_common_flags(void *data)
+int parse_common_flags(void *data)
{
static int flags_offset;
static int flags_size;
@@ -2000,7 +2000,7 @@ static int parse_common_flags(void *data)
"common_flags");
}
-static int parse_common_lock_depth(void *data)
+int parse_common_lock_depth(void *data)
{
static int ld_offset;
static int ld_size;
diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c
index c56b08d..d179ade 100644
--- a/tools/perf/util/trace-event-perl.c
+++ b/tools/perf/util/trace-event-perl.c
@@ -30,6 +30,21 @@
#include "trace-event.h"
#include "trace-event-perl.h"
+void xs_init(pTHX);
+
+void boot_Perf__Trace__Context(pTHX_ CV *cv);
+void boot_DynaLoader(pTHX_ CV *cv);
+
+void xs_init(pTHX)
+{
+ const char *file = __FILE__;
+ dXSUB_SYS;
+
+ newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context,
+ file);
+ newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
+}
+
INTERP my_perl;
#define FTRACE_MAX_EVENT \
@@ -227,6 +242,33 @@ static inline struct event *find_cache_event(int type)
return event;
}
+int get_common_pc(struct scripting_context *context)
+{
+ int pc;
+
+ pc = parse_common_pc(context->event_data);
+
+ return pc;
+}
+
+int get_common_flags(struct scripting_context *context)
+{
+ int flags;
+
+ flags = parse_common_flags(context->event_data);
+
+ return flags;
+}
+
+int get_common_lock_depth(struct scripting_context *context)
+{
+ int lock_depth;
+
+ lock_depth = parse_common_lock_depth(context->event_data);
+
+ return lock_depth;
+}
+
static void perl_process_event(int cpu, void *data,
int size __attribute((unused)),
unsigned long long nsecs, char *comm)
@@ -290,6 +332,7 @@ static void perl_process_event(int cpu, void *data,
}
PUTBACK;
+
if (get_cv(handler, 0))
call_pv(handler, G_SCALAR);
else if (get_cv("main::trace_unhandled", 0)) {
@@ -328,7 +371,8 @@ static int perl_start_script(const char *script)
my_perl = perl_alloc();
perl_construct(my_perl);
- if (perl_parse(my_perl, NULL, 2, (char **)command_line, (char **)NULL))
+ if (perl_parse(my_perl, xs_init, 2, (char **)command_line,
+ (char **)NULL))
return -1;
perl_run(my_perl);
diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h
index 6c94fa9..666a864 100644
--- a/tools/perf/util/trace-event-perl.h
+++ b/tools/perf/util/trace-event-perl.h
@@ -29,6 +29,11 @@ typedef int INTERP;
#define perl_run(a) (0)
#define perl_destruct(a) (0)
#define perl_free(a) (0)
+#define pTHX void
+#define CV void
+#define dXSUB_SYS
+#define pTHX_
+static inline void newXS(const char *a, void *b, const char *c) {}
#else
#include <EXTERN.h>
#include <perl.h>
@@ -39,4 +44,8 @@ struct scripting_context {
void *event_data;
};
+int get_common_pc(struct scripting_context *context);
+int get_common_flags(struct scripting_context *context);
+int get_common_lock_depth(struct scripting_context *context);
+
#endif /* __PERF_TRACE_EVENT_PERL_H */
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index b1e58d3..81698d5 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -246,6 +246,9 @@ extern int latency_format;
int parse_header_page(char *buf, unsigned long size);
int trace_parse_common_type(void *data);
int trace_parse_common_pid(void *data);
+int parse_common_pc(void *data);
+int parse_common_flags(void *data);
+int parse_common_lock_depth(void *data);
struct event *trace_find_event(int id);
struct event *trace_find_next_event(struct event *event);
unsigned long long read_size(void *ptr, int size);
Commit-ID: 89fbf0b8a021cbf60abeacfb6b538e97c83afada
Gitweb: http://git.kernel.org/tip/89fbf0b8a021cbf60abeacfb6b538e97c83afada
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:51 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:27 +0100
perf trace: Add Documentation for perf trace Perl support
Adds perf-trace-perl Documentation and a link to it from the
perf-trace page.
Signed-off-by: Tom Zanussi <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
tools/perf/Documentation/perf-trace-perl.txt | 219 ++++++++++++++++++++++++++
tools/perf/Documentation/perf-trace.txt | 11 ++-
2 files changed, 229 insertions(+), 1 deletions(-)
diff --git a/tools/perf/Documentation/perf-trace-perl.txt b/tools/perf/Documentation/perf-trace-perl.txt
new file mode 100644
index 0000000..c5f55f4
--- /dev/null
+++ b/tools/perf/Documentation/perf-trace-perl.txt
@@ -0,0 +1,219 @@
+perf-trace-perl(1)
+==================
+
+NAME
+----
+perf-trace-perl - Process trace data with a Perl script
+
+SYNOPSIS
+--------
+[verse]
+'perf trace' [-s [lang]:script[.ext] ]
+
+DESCRIPTION
+-----------
+
+This perf trace option is used to process perf trace data using perf's
+built-in Perl interpreter. It reads and processes the input file and
+displays the results of the trace analysis implemented in the given
+Perl script, if any.
+
+STARTER SCRIPTS
+---------------
+
+You can avoid reading the rest of this document by running 'perf trace
+-g perl' in the same directory as an existing perf.data trace file.
+That will generate a starter script containing a handler for each of
+the event types in the trace file; it simply prints every available
+field for each event in the trace file.
+
+You can also look at the existing scripts in
+~/libexec/perf-core/scripts/perl for typical examples showing how to
+do basic things like aggregate event data, print results, etc. Also,
+the check-perf-trace.pl script, while not interesting for its results,
+attempts to exercise all of the main scripting features.
+
+EVENT HANDLERS
+--------------
+
+When perf trace is invoked using a trace script, a user-defined
+'handler function' is called for each event in the trace. If there's
+no handler function defined for a given event type, the event is
+ignored (or passed to a 'trace_handled' function, see below) and the
+next event is processed.
+
+Most of the event's field values are passed as arguments to the
+handler function; some of the less common ones aren't - those are
+available as calls back into the perf executable (see below).
+
+As an example, the following perf record command can be used to record
+all sched_wakeup events in the system:
+
+ # perf record -c 1 -f -a -M -R -e sched:sched_wakeup
+
+Traces meant to be processed using a script should be recorded with
+the above options: -c 1 says to sample every event, -a to enable
+system-wide collection, -M to multiplex the output, and -R to collect
+raw samples.
+
+The format file for the sched_wakep event defines the following fields
+(see /sys/kernel/debug/tracing/events/sched/sched_wakeup/format):
+
+----
+ format:
+ field:unsigned short common_type;
+ field:unsigned char common_flags;
+ field:unsigned char common_preempt_count;
+ field:int common_pid;
+ field:int common_lock_depth;
+
+ field:char comm[TASK_COMM_LEN];
+ field:pid_t pid;
+ field:int prio;
+ field:int success;
+ field:int target_cpu;
+----
+
+The handler function for this event would be defined as:
+
+----
+sub sched::sched_wakeup
+{
+ my ($event_name, $context, $common_cpu, $common_secs,
+ $common_nsecs, $common_pid, $common_comm,
+ $comm, $pid, $prio, $success, $target_cpu) = @_;
+}
+----
+
+The handler function takes the form subsystem::event_name.
+
+The $common_* arguments in the handler's argument list are the set of
+arguments passed to all event handlers; some of the fields correspond
+to the common_* fields in the format file, but some are synthesized,
+and some of the common_* fields aren't common enough to to be passed
+to every event as arguments but are available as library functions.
+
+Here's a brief description of each of the invariant event args:
+
+ $event_name the name of the event as text
+ $context an opaque 'cookie' used in calls back into perf
+ $common_cpu the cpu the event occurred on
+ $common_secs the secs portion of the event timestamp
+ $common_nsecs the nsecs portion of the event timestamp
+ $common_pid the pid of the current task
+ $common_comm the name of the current process
+
+All of the remaining fields in the event's format file have
+counterparts as handler function arguments of the same name, as can be
+seen in the example above.
+
+The above provides the basics needed to directly access every field of
+every event in a trace, which covers 90% of what you need to know to
+write a useful trace script. The sections below cover the rest.
+
+SCRIPT LAYOUT
+-------------
+
+Every perf trace Perl script should start by setting up a Perl module
+search path and 'use'ing a few support modules (see module
+descriptions below):
+
+----
+ use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
+ use lib "./Perf-Trace-Util/lib";
+ use Perf::Trace::Core;
+ use Perf::Trace::Context;
+ use Perf::Trace::Util;
+----
+
+The rest of the script can contain handler functions and support
+functions in any order.
+
+Aside from the event handler functions discussed above, every script
+can implement a set of optional functions:
+
+*trace_begin*, if defined, is called before any event is processed and
+gives scripts a chance to do setup tasks:
+
+----
+ sub trace_begin
+ {
+ }
+----
+
+*trace_end*, if defined, is called after all events have been
+ processed and gives scripts a chance to do end-of-script tasks, such
+ as display results:
+
+----
+sub trace_end
+{
+}
+----
+
+*trace_unhandled*, if defined, is called after for any event that
+ doesn't have a handler explicitly defined for it. The standard set
+ of common arguments are passed into it:
+
+----
+sub trace_unhandled
+{
+ my ($event_name, $context, $common_cpu, $common_secs,
+ $common_nsecs, $common_pid, $common_comm) = @_;
+}
+----
+
+The remaining sections provide descriptions of each of the available
+built-in perf trace Perl modules and their associated functions.
+
+AVAILABLE MODULES AND FUNCTIONS
+-------------------------------
+
+The following sections describe the functions and variables available
+via the various Perf::Trace::* Perl modules. To use the functions and
+variables from the given module, add the corresponding 'use
+Perf::Trace::XXX' line to your perf trace script.
+
+Perf::Trace::Core Module
+~~~~~~~~~~~~~~~~~~~~~~~~
+
+These functions provide some essential functions to user scripts.
+
+The *flag_str* and *symbol_str* functions provide human-readable
+strings for flag and symbolic fields. These correspond to the strings
+and values parsed from the 'print fmt' fields of the event format
+files:
+
+ flag_str($event_name, $field_name, $field_value) - returns the string represention corresponding to $field_value for the flag field $field_name of event $event_name
+ symbol_str($event_name, $field_name, $field_value) - returns the string represention corresponding to $field_value for the symbolic field $field_name of event $event_name
+
+Perf::Trace::Context Module
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Some of the 'common' fields in the event format file aren't all that
+common, but need to be made accessible to user scripts nonetheless.
+
+Perf::Trace::Context defines a set of functions that can be used to
+access this data in the context of the current event. Each of these
+functions expects a $context variable, which is the same as the
+$context variable passed into every event handler as the second
+argument.
+
+ common_pc($context) - returns common_preempt count for the current event
+ common_flags($context) - returns common_flags for the current event
+ common_lock_depth($context) - returns common_lock_depth for the current event
+
+Perf::Trace::Util Module
+~~~~~~~~~~~~~~~~~~~~~~~~
+
+Various utility functions for use with perf trace:
+
+ nsecs($secs, $nsecs) - returns total nsecs given secs/nsecs pair
+ nsecs_secs($nsecs) - returns whole secs portion given nsecs
+ nsecs_nsecs($nsecs) - returns nsecs remainder given nsecs
+ nsecs_str($nsecs) - returns printable string in the form secs.nsecs
+ avg($total, $n) - returns average given a sum and a total number of values
+
+SEE ALSO
+--------
+linkperf:perf-trace[1]
diff --git a/tools/perf/Documentation/perf-trace.txt b/tools/perf/Documentation/perf-trace.txt
index 41ed753..07065ef 100644
--- a/tools/perf/Documentation/perf-trace.txt
+++ b/tools/perf/Documentation/perf-trace.txt
@@ -20,6 +20,15 @@ OPTIONS
--dump-raw-trace=::
Display verbose dump of the trace data.
+-s::
+--script=::
+ Process trace data with the given script ([lang]:script[.ext]).
+
+-g::
+--gen-script=::
+ Generate perf-trace.[ext] starter script for given language,
+ using current perf.data.
+
SEE ALSO
--------
-linkperf:perf-record[1]
+linkperf:perf-record[1], linkperf:perf-trace-perl[1]
Commit-ID: 1ae4a971250c55e473ca53c78011fcf73809885d
Gitweb: http://git.kernel.org/tip/1ae4a971250c55e473ca53c78011fcf73809885d
Author: Tom Zanussi <[email protected]>
AuthorDate: Wed, 25 Nov 2009 01:15:52 -0600
Committer: Ingo Molnar <[email protected]>
CommitDate: Sat, 28 Nov 2009 10:04:27 +0100
perf trace: Add a scripts/perl/bin for perf trace shell scripts
To capture the relevant events for a given Perl script and to
avoid having to continually remember and type in long
command-lines, add a scripts/perl/bin directory containing two
simple shell scripts for each Perl script, one for recording and
one for processing/display. For example, to record perf data for
the rw-by-pid.pl script, run scripts/perl/bin/rw-by-pid-record
and to actually run the script and display the output run
scripts/perl/bin/rw-by-pid-report.
Signed-off-by: Tom Zanussi <[email protected]>
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
Cc: [email protected]
LKML-Reference: <[email protected]>
Signed-off-by: Ingo Molnar <[email protected]>
---
.../perf/scripts/perl/bin/check-perf-trace-record | 7 +++++++
.../perf/scripts/perl/bin/check-perf-trace-report | 5 +++++
tools/perf/scripts/perl/bin/rw-by-file-record | 2 ++
tools/perf/scripts/perl/bin/rw-by-file-report | 5 +++++
tools/perf/scripts/perl/bin/rw-by-pid-record | 2 ++
tools/perf/scripts/perl/bin/rw-by-pid-report | 5 +++++
tools/perf/scripts/perl/bin/wakeup-latency-record | 6 ++++++
tools/perf/scripts/perl/bin/wakeup-latency-report | 5 +++++
tools/perf/scripts/perl/bin/workqueue-stats-record | 2 ++
tools/perf/scripts/perl/bin/workqueue-stats-report | 6 ++++++
10 files changed, 45 insertions(+), 0 deletions(-)
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 0000000..c7ec5de
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/check-perf-trace-record
@@ -0,0 +1,7 @@
+#!/bin/bash
+perf record -c 1 -f -a -M -R -e kmem:kmalloc -e irq:softirq_entry
+
+
+
+
+
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 0000000..89948b0
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/check-perf-trace-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/check-perf-trace.pl
+
+
+
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 0000000..b25056e
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-file-record
@@ -0,0 +1,2 @@
+#!/bin/bash
+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 0000000..f5dcf9c
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-file-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl
+
+
+
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 0000000..8903979
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-pid-record
@@ -0,0 +1,2 @@
+#!/bin/bash
+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 0000000..cea16f7
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-pid-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl
+
+
+
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 0000000..6abedda
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/wakeup-latency-record
@@ -0,0 +1,6 @@
+#!/bin/bash
+perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup
+
+
+
+
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 0000000..85769dc
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/wakeup-latency-report
@@ -0,0 +1,5 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl
+
+
+
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 0000000..fce6637
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/workqueue-stats-record
@@ -0,0 +1,2 @@
+#!/bin/bash
+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 0000000..aa68435
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/workqueue-stats-report
@@ -0,0 +1,6 @@
+#!/bin/bash
+perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl
+
+
+
+