From 956ffd027bedc4106b901eb6a50f0a6c6de4113d Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Wed, 25 Nov 2009 01:15:46 -0600 Subject: 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 Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259133352-23685-2-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event.h | 11 +++++++++++ 1 file changed, 11 insertions(+) (limited to 'tools/perf/util') diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h index dd51c6872a1..e7aaf002e66 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 */ -- cgit v1.2.3 From eb9a42caa7a926beb935a22bc59d981b35f0b652 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Wed, 25 Nov 2009 01:15:47 -0600 Subject: 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 Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259133352-23685-3-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-parse.c | 17 +++++++++++++++++ tools/perf/util/trace-event.h | 2 ++ 2 files changed, 19 insertions(+) (limited to 'tools/perf/util') diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c index 7021dc1b0ca..85d7163a9fd 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 e7aaf002e66..aeb915778ae 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 { -- cgit v1.2.3 From 16c632de64a74644a46e7636db26b2cfb530ca13 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Wed, 25 Nov 2009 01:15:48 -0600 Subject: 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 Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259133352-23685-4-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- 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 + 4 files changed, 614 insertions(+), 5 deletions(-) create mode 100644 tools/perf/util/trace-event-perl.c create mode 100644 tools/perf/util/trace-event-perl.h (limited to 'tools/perf/util') diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c index 85d7163a9fd..1f16495e559 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 00000000000..c56b08d704d --- /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 + * + * 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 +#include +#include +#include +#include + +#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 00000000000..6c94fa93013 --- /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 +#include +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 aeb915778ae..b1e58d3d947 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 */ -- cgit v1.2.3 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-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 +++ 4 files changed, 60 insertions(+), 4 deletions(-) (limited to 'tools/perf/util') diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c index 1f16495e559..0302405aa2c 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 c56b08d704d..d179adebc54 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 6c94fa93013..666a864f5dd 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 #include @@ -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 b1e58d3d947..81698d5e650 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); -- cgit v1.2.3 From 61381de0504181368672a83d2e14c38dbaf3c136 Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Mon, 30 Nov 2009 01:18:48 -0600 Subject: perf trace/scripting: Fix Perl common_* access functions The common_* functions (e.g. common_pc(), etc) are exported as common_* but named get_common_*, resulting in unresolved subroutine errors when executing scripts. Make the internal and external names match. Signed-off-by: Tom Zanussi Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259565529-6407-4-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-perl.c | 6 +++--- tools/perf/util/trace-event-perl.h | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) (limited to 'tools/perf/util') diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c index d179adebc54..2e1cc3c11c7 100644 --- a/tools/perf/util/trace-event-perl.c +++ b/tools/perf/util/trace-event-perl.c @@ -242,7 +242,7 @@ static inline struct event *find_cache_event(int type) return event; } -int get_common_pc(struct scripting_context *context) +int common_pc(struct scripting_context *context) { int pc; @@ -251,7 +251,7 @@ int get_common_pc(struct scripting_context *context) return pc; } -int get_common_flags(struct scripting_context *context) +int common_flags(struct scripting_context *context) { int flags; @@ -260,7 +260,7 @@ int get_common_flags(struct scripting_context *context) return flags; } -int get_common_lock_depth(struct scripting_context *context) +int common_lock_depth(struct scripting_context *context) { int lock_depth; diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h index 666a864f5dd..8fe0d866fe1 100644 --- a/tools/perf/util/trace-event-perl.h +++ b/tools/perf/util/trace-event-perl.h @@ -44,8 +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); +int common_pc(struct scripting_context *context); +int common_flags(struct scripting_context *context); +int common_lock_depth(struct scripting_context *context); #endif /* __PERF_TRACE_EVENT_PERL_H */ -- cgit v1.2.3 From 8ea339adc0a48236008e59dd21564d71c37b331c Mon Sep 17 00:00:00 2001 From: Tom Zanussi Date: Mon, 30 Nov 2009 01:18:49 -0600 Subject: perf trace/scripting: Add Fedora libperl install note to doc Fedora needs perl-ExtUtils-Embed for Perl scripting, which also brings along libperl-devel; note this info for the convenience of Fedora users. Signed-off-by: Tom Zanussi Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259565529-6407-5-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar --- tools/perf/util/trace-event-perl.c | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'tools/perf/util') diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c index 2e1cc3c11c7..51e833fd58c 100644 --- a/tools/perf/util/trace-event-perl.c +++ b/tools/perf/util/trace-event-perl.c @@ -577,7 +577,9 @@ struct scripting_ops perl_scripting_ops = { void setup_perl_scripting(void) { fprintf(stderr, "Perl scripting not supported." - " Install libperl-dev[el] and rebuild perf to get it.\n"); + " Install libperl and rebuild perf to enable it. e.g. " + "apt-get install libperl-dev (ubuntu), yum install " + "perl-ExtUtils-Embed (Fedora), etc.\n"); } #else void setup_perl_scripting(void) -- cgit v1.2.3