summaryrefslogtreecommitdiffstats
path: root/tools/perf/util/scripting-engines
diff options
context:
space:
mode:
authorDima Kogan <dima@secretsauce.net>2016-03-29 12:47:53 -0300
committerArnaldo Carvalho de Melo <acme@redhat.com>2016-03-30 11:14:09 -0300
commitf7380c12ec6cfd69f274ba6181cd01c764f877bb (patch)
treeba89f3cad389a073b0ae88878e9fa6f10d9ce513 /tools/perf/util/scripting-engines
parent37194f443a5a7157866ba68b04827e111100167b (diff)
downloadop-kernel-dev-f7380c12ec6cfd69f274ba6181cd01c764f877bb.zip
op-kernel-dev-f7380c12ec6cfd69f274ba6181cd01c764f877bb.tar.gz
perf script perl: Perl scripts now get a backtrace, like the python ones
We have some infrastructure to use perl or python to analyze logs generated by perf. Prior to this patch, only the python tools had access to backtrace information. This patch makes this information available to perl scripts as well. Example: Let's look at malloc() calls made by the seq utility. First we create a probe point: $ perf probe -x /lib/x86_64-linux-gnu/libc.so.6 malloc Added new events: ... Now we run seq, while monitoring malloc() calls with perf $ perf record --call-graph=dwarf -e probe_libc:malloc seq 5 1 2 3 4 5 [ perf record: Woken up 1 times to write data ] [ perf record: Captured and wrote 0.064 MB perf.data (6 samples) ] We can use perf to look at its log to see the malloc calls and the backtrace $ perf script seq 14195 [000] 1927993.748254: probe_libc:malloc: (7f9ff8edd320) bytes=0x22 7f9ff8edd320 malloc (/lib/x86_64-linux-gnu/libc-2.22.so) 7f9ff8e8eab0 set_binding_values.part.0 (/lib/x86_64-linux-gnu/libc-2.22.so) 7f9ff8e8eda1 __bindtextdomain (/lib/x86_64-linux-gnu/libc-2.22.so) 401b22 main (/usr/bin/seq) 7f9ff8e82610 __libc_start_main (/lib/x86_64-linux-gnu/libc-2.22.so) 402799 _start (/usr/bin/seq) ... We can also use the scripting facilities. We create a skeleton perl script that simply prints out the events $ perf script -g perl generated Perl script: perf-script.pl We can then use this script to see the malloc() calls with a backtrace. Prior to this patch, the backtrace was not available to the perl scripts. $ perf script -s perf-script.pl probe_libc::malloc 0 1927993.748254260 14195 seq __probe_ip=140325052863264, bytes=34 [7f9ff8edd320] malloc [7f9ff8e8eab0] set_binding_values.part.0 [7f9ff8e8eda1] __bindtextdomain [401b22] main [7f9ff8e82610] __libc_start_main [402799] _start ... Tested-by: Arnaldo Carvalho de Melo <acme@redhat.com> Link: http://lkml.kernel.org/r/87mvphzld0.fsf@secretsauce.net Signed-off-by: Dima Kogan <dima@secretsauce.net>
Diffstat (limited to 'tools/perf/util/scripting-engines')
-rw-r--r--tools/perf/util/scripting-engines/trace-event-perl.c114
1 files changed, 106 insertions, 8 deletions
diff --git a/tools/perf/util/scripting-engines/trace-event-perl.c b/tools/perf/util/scripting-engines/trace-event-perl.c
index b3aabc0..1d16085 100644
--- a/tools/perf/util/scripting-engines/trace-event-perl.c
+++ b/tools/perf/util/scripting-engines/trace-event-perl.c
@@ -31,6 +31,8 @@
#include <perl.h>
#include "../../perf.h"
+#include "../callchain.h"
+#include "../machine.h"
#include "../thread.h"
#include "../event.h"
#include "../trace-event.h"
@@ -248,10 +250,78 @@ static void define_event_symbols(struct event_format *event,
define_event_symbols(event, ev_name, args->next);
}
+static SV *perl_process_callchain(struct perf_sample *sample,
+ struct perf_evsel *evsel,
+ struct addr_location *al)
+{
+ AV *list;
+
+ list = newAV();
+ if (!list)
+ goto exit;
+
+ if (!symbol_conf.use_callchain || !sample->callchain)
+ goto exit;
+
+ if (thread__resolve_callchain(al->thread, evsel,
+ sample, NULL, NULL,
+ PERF_MAX_STACK_DEPTH) != 0) {
+ pr_err("Failed to resolve callchain. Skipping\n");
+ goto exit;
+ }
+ callchain_cursor_commit(&callchain_cursor);
+
+
+ while (1) {
+ HV *elem;
+ struct callchain_cursor_node *node;
+ node = callchain_cursor_current(&callchain_cursor);
+ if (!node)
+ break;
+
+ elem = newHV();
+ if (!elem)
+ goto exit;
+
+ hv_stores(elem, "ip", newSVuv(node->ip));
+
+ if (node->sym) {
+ HV *sym = newHV();
+ if (!sym)
+ goto exit;
+ hv_stores(sym, "start", newSVuv(node->sym->start));
+ hv_stores(sym, "end", newSVuv(node->sym->end));
+ hv_stores(sym, "binding", newSVuv(node->sym->binding));
+ hv_stores(sym, "name", newSVpvn(node->sym->name,
+ node->sym->namelen));
+ hv_stores(elem, "sym", newRV_noinc((SV*)sym));
+ }
+
+ if (node->map) {
+ struct map *map = node->map;
+ const char *dsoname = "[unknown]";
+ if (map && map->dso && (map->dso->name || map->dso->long_name)) {
+ if (symbol_conf.show_kernel_path && map->dso->long_name)
+ dsoname = map->dso->long_name;
+ else if (map->dso->name)
+ dsoname = map->dso->name;
+ }
+ hv_stores(elem, "dso", newSVpv(dsoname,0));
+ }
+
+ callchain_cursor_advance(&callchain_cursor);
+ av_push(list, newRV_noinc((SV*)elem));
+ }
+
+exit:
+ return newRV_noinc((SV*)list);
+}
+
static void perl_process_tracepoint(struct perf_sample *sample,
struct perf_evsel *evsel,
- struct thread *thread)
+ struct addr_location *al)
{
+ struct thread *thread = al->thread;
struct event_format *event = evsel->tp_format;
struct format_field *field;
static char handler[256];
@@ -295,6 +365,7 @@ static void perl_process_tracepoint(struct perf_sample *sample,
XPUSHs(sv_2mortal(newSVuv(ns)));
XPUSHs(sv_2mortal(newSViv(pid)));
XPUSHs(sv_2mortal(newSVpv(comm, 0)));
+ XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
/* common fields other than pid can be accessed via xsub fns */
@@ -329,6 +400,7 @@ static void perl_process_tracepoint(struct perf_sample *sample,
XPUSHs(sv_2mortal(newSVuv(nsecs)));
XPUSHs(sv_2mortal(newSViv(pid)));
XPUSHs(sv_2mortal(newSVpv(comm, 0)));
+ XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
call_pv("main::trace_unhandled", G_SCALAR);
}
SPAGAIN;
@@ -366,7 +438,7 @@ static void perl_process_event(union perf_event *event,
struct perf_evsel *evsel,
struct addr_location *al)
{
- perl_process_tracepoint(sample, evsel, al->thread);
+ perl_process_tracepoint(sample, evsel, al);
perl_process_event_generic(event, sample, evsel);
}
@@ -490,7 +562,27 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
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");
+ fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n");
+
+
+ fprintf(ofp, "\n\
+sub print_backtrace\n\
+{\n\
+ my $callchain = shift;\n\
+ for my $node (@$callchain)\n\
+ {\n\
+ if(exists $node->{sym})\n\
+ {\n\
+ printf( \"\\t[\\%%x] \\%%s\\n\", $node->{ip}, $node->{sym}{name});\n\
+ }\n\
+ else\n\
+ {\n\
+ printf( \"\\t[\\%%x]\\n\", $node{ip});\n\
+ }\n\
+ }\n\
+}\n\n\
+");
+
while ((event = trace_find_next_event(pevent, event))) {
fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
@@ -502,7 +594,8 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
fprintf(ofp, "$common_secs, ");
fprintf(ofp, "$common_nsecs,\n");
fprintf(ofp, "\t $common_pid, ");
- fprintf(ofp, "$common_comm,\n\t ");
+ fprintf(ofp, "$common_comm, ");
+ fprintf(ofp, "$common_callchain,\n\t ");
not_first = 0;
count = 0;
@@ -519,7 +612,7 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
"$common_secs, $common_nsecs,\n\t "
- "$common_pid, $common_comm);\n\n");
+ "$common_pid, $common_comm, $common_callchain);\n\n");
fprintf(ofp, "\tprintf(\"");
@@ -581,17 +674,22 @@ static int perl_generate_script(struct pevent *pevent, const char *outfile)
fprintf(ofp, "$%s", f->name);
}
- fprintf(ofp, ");\n");
+ fprintf(ofp, ");\n\n");
+
+ fprintf(ofp, "\tprint_backtrace($common_callchain);\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");
+ "$common_pid, $common_comm, $common_callchain) = @_;\n\n");
fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
"$common_secs, $common_nsecs,\n\t $common_pid, "
- "$common_comm);\n}\n\n");
+ "$common_comm, $common_callchain);\n");
+ fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
+ fprintf(ofp, "}\n\n");
fprintf(ofp, "sub print_header\n{\n"
"\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
OpenPOWER on IntegriCloud