From d1b93772be78486397693fc39d3ddea3fda90105 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Wed, 25 Nov 2009 01:15:50 -0600 Subject: 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 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 --- tools/perf/util/trace-event-perl.c | 46 +++++++++++++++++++++++++++++++++++++- 1 file changed, 45 insertions(+), 1 deletion(-) (limited to 'tools/perf/util/trace-event-perl.c') 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); -- cgit v1.1