lkml.org 
[lkml]   [2016]   [Mar]   [28]   [last100]   RSS Feed
Views: [wrap][no wrap]   [headers]  [forward] 
 
Messages in this thread
    /
    Date
    From
    SubjectRe: [PATCH] perf: perl scripts now get a backtrace, like the python scripts
    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"

    \
     
     \ /
      Last update: 2016-03-28 23:21    [W:4.672 / U:0.012 seconds]
    ©2003-2020 Jasper Spaans|hosted at Digital Ocean and TransIP|Read the blog|Advertise on this site