d1b93772be
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 <tzanussi@gmail.com> Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259133352-23685-6-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar <mingo@elte.hu>
107 lines
2.6 KiB
Raku
107 lines
2.6 KiB
Raku
# perf trace event handlers, generated by perf trace -g perl
|
|
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
|
|
# 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);
|
|
}
|