Em Tue, Mar 29, 2016 at 02:25:47AM -0700, Dima Kogan escreveu:
> Arnaldo Carvalho de Melo <a...@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 <d...@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 <d...@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
>
