* [PATCH] perf: perl scripts now get a backtrace, like the python scripts
@ 2016-03-25 18:31 Dima Kogan
2016-03-28 21:03 ` Arnaldo Carvalho de Melo
0 siblings, 1 reply; 5+ messages in thread
From: Dima Kogan @ 2016-03-25 18:31 UTC (permalink / raw)
To: linux-kernel; +Cc: Arnaldo Carvalho de Melo
[-- Attachment #1: Type: text/plain, Size: 271 bytes --]
Hi.
Currently the python perf scripts get a backtrace, while the perl ones do not.
This patch adds that to the perl scripts as well.
---
.../perf/util/scripting-engines/trace-event-perl.c | 115 +++++++++++++++++++--
1 file changed, 107 insertions(+), 8 deletions(-)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-perf-perl-scripts-now-get-a-backtrace-like-the-pytho.patch --]
[-- Type: text/x-patch; name="0001-perf-perl-scripts-now-get-a-backtrace-like-the-pytho.patch", Size: 5976 bytes --]
diff --git a/tools/perf/util/scripting-engines/trace-event-perl.c b/tools/perf/util/scripting-engines/trace-event-perl.c
index 1bd593b..f048c58 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"
@@ -244,10 +246,79 @@ 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;
+
+ // mortal?
+ 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];
@@ -291,6 +362,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 */
@@ -325,6 +397,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;
@@ -362,7 +435,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);
}
@@ -486,7 +559,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);
@@ -498,7 +591,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;
@@ -515,7 +609,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(\"");
@@ -577,17 +671,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"
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] perf: perl scripts now get a backtrace, like the python scripts
2016-03-25 18:31 [PATCH] perf: perl scripts now get a backtrace, like the python scripts Dima Kogan
@ 2016-03-28 21:03 ` Arnaldo Carvalho de Melo
2016-03-29 9:25 ` Dima Kogan
0 siblings, 1 reply; 5+ messages in thread
From: Arnaldo Carvalho de Melo @ 2016-03-28 21:03 UTC (permalink / raw)
To: Dima Kogan; +Cc: linux-kernel
Em Fri, Mar 25, 2016 at 11:31:54AM -0700, Dima Kogan escreveu:
> Hi.
>
> Currently the python perf scripts get a backtrace, while the perl ones do not.
> This patch adds that to the perl scripts as well.
Can you send as a single message, with your Signed-off-by, and with an
example of this in use? I.e. a simple perl script that used with 'perf
script' exercises this new code, so that we can see, in the changeset
log message how this is used, etc?
Please take a look at Documentation/SubmittingPatches.
- Arnaldo
> ---
> .../perf/util/scripting-engines/trace-event-perl.c | 115 +++++++++++++++++++--
> 1 file changed, 107 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 1bd593b..f048c58 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"
> @@ -244,10 +246,79 @@ 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;
> +
> + // mortal?
> + 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];
> @@ -291,6 +362,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 */
>
> @@ -325,6 +397,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;
> @@ -362,7 +435,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);
> }
>
> @@ -486,7 +559,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);
> @@ -498,7 +591,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;
> @@ -515,7 +609,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(\"");
>
> @@ -577,17 +671,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"
^ permalink raw reply [flat|nested] 5+ messages in thread
* Re: [PATCH] perf: perl scripts now get a backtrace, like the python scripts
2016-03-28 21:03 ` Arnaldo Carvalho de Melo
@ 2016-03-29 9:25 ` Dima Kogan
2016-03-29 16:07 ` Arnaldo Carvalho de Melo
2016-03-31 6:54 ` [tip:perf/core] perf script perl: Perl scripts now get a backtrace, like the python ones tip-bot for Dima Kogan
0 siblings, 2 replies; 5+ messages in thread
From: Dima Kogan @ 2016-03-29 9:25 UTC (permalink / raw)
To: Arnaldo Carvalho de Melo; +Cc: linux-kernel
[-- Attachment #1: Type: text/plain, Size: 655 bytes --]
Arnaldo Carvalho de Melo <acme@kernel.org> writes:
> Em Fri, Mar 25, 2016 at 11:31:54AM -0700, Dima Kogan escreveu:
>> Hi.
>>
>> Currently the python perf scripts get a backtrace, while the perl ones do not.
>> This patch adds that to the perl scripts as well.
>
> Can you send as a single message, with your Signed-off-by, and with an
> example of this in use? I.e. a simple perl script that used with 'perf
> script' exercises this new code, so that we can see, in the changeset
> log message how this is used, etc?
>
> Please take a look at Documentation/SubmittingPatches.
OK. Here's the patch again with the changes you requested in the
message.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-perf-perl-scripts-now-get-a-backtrace-like-the-pytho.patch --]
[-- Type: text/x-diff, Size: 8507 bytes --]
>From 652bdf06f613c12f65eee294539bb0259abeceda Mon Sep 17 00:00:00 2001
From: Dima Kogan <dima@secretsauce.net>
Date: Fri, 25 Mar 2016 11:31:54 -0700
Subject: [PATCH] perf: perl scripts now get a backtrace, like the python
scripts
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 tracepoint
$ 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
...
Signed-off-by: Dima Kogan <dima@secretsauce.net>
---
.../perf/util/scripting-engines/trace-event-perl.c | 114 +++++++++++++++++++--
1 file 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 1bd593b..db3bb4b 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"
@@ -244,10 +246,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];
@@ -291,6 +361,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 */
@@ -325,6 +396,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;
@@ -362,7 +434,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);
}
@@ -486,7 +558,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);
@@ -498,7 +590,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;
@@ -515,7 +608,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(\"");
@@ -577,17 +670,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"
--
2.1.4
^ permalink raw reply related [flat|nested] 5+ messages in thread
* Re: [PATCH] perf: perl scripts now get a backtrace, like the python scripts
2016-03-29 9:25 ` Dima Kogan
@ 2016-03-29 16:07 ` Arnaldo Carvalho de Melo
2016-03-31 6:54 ` [tip:perf/core] perf script perl: Perl scripts now get a backtrace, like the python ones tip-bot for Dima Kogan
1 sibling, 0 replies; 5+ messages in thread
From: Arnaldo Carvalho de Melo @ 2016-03-29 16:07 UTC (permalink / raw)
To: Dima Kogan; +Cc: linux-kernel
Em Tue, Mar 29, 2016 at 02:25:47AM -0700, Dima Kogan escreveu:
> Arnaldo Carvalho de Melo <acme@kernel.org> writes:
>
> > Em Fri, Mar 25, 2016 at 11:31:54AM -0700, Dima Kogan escreveu:
> >> Hi.
> >>
> >> Currently the python perf scripts get a backtrace, while the perl ones do not.
> >> This patch adds that to the perl scripts as well.
> >
> > Can you send as a single message, with your Signed-off-by, and with an
> > example of this in use? I.e. a simple perl script that used with 'perf
> > script' exercises this new code, so that we can see, in the changeset
> > log message how this is used, etc?
> >
> > Please take a look at Documentation/SubmittingPatches.
>
> OK. Here's the patch again with the changes you requested in the
> message.
Thanks, with a bit more twiddling I got it merged, hint: don't send
attachments.
I tested it and it seems to work, thanks for doing this.
- Arnaldo
> >From 652bdf06f613c12f65eee294539bb0259abeceda Mon Sep 17 00:00:00 2001
> From: Dima Kogan <dima@secretsauce.net>
> Date: Fri, 25 Mar 2016 11:31:54 -0700
> Subject: [PATCH] perf: perl scripts now get a backtrace, like the python
> scripts
>
> 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 tracepoint
>
> $ 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
> ...
>
> Signed-off-by: Dima Kogan <dima@secretsauce.net>
> ---
> .../perf/util/scripting-engines/trace-event-perl.c | 114 +++++++++++++++++++--
> 1 file 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 1bd593b..db3bb4b 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"
> @@ -244,10 +246,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];
> @@ -291,6 +361,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 */
>
> @@ -325,6 +396,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;
> @@ -362,7 +434,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);
> }
>
> @@ -486,7 +558,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);
> @@ -498,7 +590,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;
> @@ -515,7 +608,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(\"");
>
> @@ -577,17 +670,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"
> --
> 2.1.4
>
^ permalink raw reply [flat|nested] 5+ messages in thread
* [tip:perf/core] perf script perl: Perl scripts now get a backtrace, like the python ones
2016-03-29 9:25 ` Dima Kogan
2016-03-29 16:07 ` Arnaldo Carvalho de Melo
@ 2016-03-31 6:54 ` tip-bot for Dima Kogan
1 sibling, 0 replies; 5+ messages in thread
From: tip-bot for Dima Kogan @ 2016-03-31 6:54 UTC (permalink / raw)
To: linux-tip-commits; +Cc: linux-kernel, mingo, dima, acme, hpa, tglx
Commit-ID: f7380c12ec6cfd69f274ba6181cd01c764f877bb
Gitweb: http://git.kernel.org/tip/f7380c12ec6cfd69f274ba6181cd01c764f877bb
Author: Dima Kogan <dima@secretsauce.net>
AuthorDate: Tue, 29 Mar 2016 12:47:53 -0300
Committer: Arnaldo Carvalho de Melo <acme@redhat.com>
CommitDate: Wed, 30 Mar 2016 11:14:09 -0300
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>
---
.../perf/util/scripting-engines/trace-event-perl.c | 114 +++++++++++++++++++--
1 file 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"
^ permalink raw reply related [flat|nested] 5+ messages in thread
end of thread, other threads:[~2016-03-31 6:54 UTC | newest]
Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-03-25 18:31 [PATCH] perf: perl scripts now get a backtrace, like the python scripts Dima Kogan
2016-03-28 21:03 ` Arnaldo Carvalho de Melo
2016-03-29 9:25 ` Dima Kogan
2016-03-29 16:07 ` Arnaldo Carvalho de Melo
2016-03-31 6:54 ` [tip:perf/core] perf script perl: Perl scripts now get a backtrace, like the python ones tip-bot for Dima Kogan
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.