Back to home page

OSCL-LXR
 
 

     

0001 /*
0002  * trace-event-perl.  Feed perf script events to an embedded Perl interpreter.
0003  *
0004  * Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
0005  *
0006  *  This program is free software; you can redistribute it and/or modify
0007  *  it under the terms of the GNU General Public License as published by
0008  *  the Free Software Foundation; either version 2 of the License, or
0009  *  (at your option) any later version.
0010  *
0011  *  This program is distributed in the hope that it will be useful,
0012  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
0013  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
0014  *  GNU General Public License for more details.
0015  *
0016  *  You should have received a copy of the GNU General Public License
0017  *  along with this program; if not, write to the Free Software
0018  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
0019  *
0020  */
0021 
0022 #include <inttypes.h>
0023 #include <stdio.h>
0024 #include <stdlib.h>
0025 #include <string.h>
0026 #include <ctype.h>
0027 #include <errno.h>
0028 #include <linux/bitmap.h>
0029 #include <linux/time64.h>
0030 
0031 #include <stdbool.h>
0032 /* perl needs the following define, right after including stdbool.h */
0033 #define HAS_BOOL
0034 #include <EXTERN.h>
0035 #include <perl.h>
0036 
0037 #include "../callchain.h"
0038 #include "../dso.h"
0039 #include "../machine.h"
0040 #include "../map.h"
0041 #include "../symbol.h"
0042 #include "../thread.h"
0043 #include "../event.h"
0044 #include "../trace-event.h"
0045 #include "../evsel.h"
0046 #include "../debug.h"
0047 
0048 void boot_Perf__Trace__Context(pTHX_ CV *cv);
0049 void boot_DynaLoader(pTHX_ CV *cv);
0050 typedef PerlInterpreter * INTERP;
0051 
0052 void xs_init(pTHX);
0053 
0054 void xs_init(pTHX)
0055 {
0056     const char *file = __FILE__;
0057     dXSUB_SYS;
0058 
0059     newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context,
0060           file);
0061     newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
0062 }
0063 
0064 INTERP my_perl;
0065 
0066 #define TRACE_EVENT_TYPE_MAX                \
0067     ((1 << (sizeof(unsigned short) * 8)) - 1)
0068 
0069 static DECLARE_BITMAP(events_defined, TRACE_EVENT_TYPE_MAX);
0070 
0071 extern struct scripting_context *scripting_context;
0072 
0073 static char *cur_field_name;
0074 static int zero_flag_atom;
0075 
0076 static void define_symbolic_value(const char *ev_name,
0077                   const char *field_name,
0078                   const char *field_value,
0079                   const char *field_str)
0080 {
0081     unsigned long long value;
0082     dSP;
0083 
0084     value = eval_flag(field_value);
0085 
0086     ENTER;
0087     SAVETMPS;
0088     PUSHMARK(SP);
0089 
0090     XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
0091     XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
0092     XPUSHs(sv_2mortal(newSVuv(value)));
0093     XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
0094 
0095     PUTBACK;
0096     if (get_cv("main::define_symbolic_value", 0))
0097         call_pv("main::define_symbolic_value", G_SCALAR);
0098     SPAGAIN;
0099     PUTBACK;
0100     FREETMPS;
0101     LEAVE;
0102 }
0103 
0104 static void define_symbolic_values(struct tep_print_flag_sym *field,
0105                    const char *ev_name,
0106                    const char *field_name)
0107 {
0108     define_symbolic_value(ev_name, field_name, field->value, field->str);
0109     if (field->next)
0110         define_symbolic_values(field->next, ev_name, field_name);
0111 }
0112 
0113 static void define_symbolic_field(const char *ev_name,
0114                   const char *field_name)
0115 {
0116     dSP;
0117 
0118     ENTER;
0119     SAVETMPS;
0120     PUSHMARK(SP);
0121 
0122     XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
0123     XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
0124 
0125     PUTBACK;
0126     if (get_cv("main::define_symbolic_field", 0))
0127         call_pv("main::define_symbolic_field", G_SCALAR);
0128     SPAGAIN;
0129     PUTBACK;
0130     FREETMPS;
0131     LEAVE;
0132 }
0133 
0134 static void define_flag_value(const char *ev_name,
0135                   const char *field_name,
0136                   const char *field_value,
0137                   const char *field_str)
0138 {
0139     unsigned long long value;
0140     dSP;
0141 
0142     value = eval_flag(field_value);
0143 
0144     ENTER;
0145     SAVETMPS;
0146     PUSHMARK(SP);
0147 
0148     XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
0149     XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
0150     XPUSHs(sv_2mortal(newSVuv(value)));
0151     XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
0152 
0153     PUTBACK;
0154     if (get_cv("main::define_flag_value", 0))
0155         call_pv("main::define_flag_value", G_SCALAR);
0156     SPAGAIN;
0157     PUTBACK;
0158     FREETMPS;
0159     LEAVE;
0160 }
0161 
0162 static void define_flag_values(struct tep_print_flag_sym *field,
0163                    const char *ev_name,
0164                    const char *field_name)
0165 {
0166     define_flag_value(ev_name, field_name, field->value, field->str);
0167     if (field->next)
0168         define_flag_values(field->next, ev_name, field_name);
0169 }
0170 
0171 static void define_flag_field(const char *ev_name,
0172                   const char *field_name,
0173                   const char *delim)
0174 {
0175     dSP;
0176 
0177     ENTER;
0178     SAVETMPS;
0179     PUSHMARK(SP);
0180 
0181     XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
0182     XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
0183     XPUSHs(sv_2mortal(newSVpv(delim, 0)));
0184 
0185     PUTBACK;
0186     if (get_cv("main::define_flag_field", 0))
0187         call_pv("main::define_flag_field", G_SCALAR);
0188     SPAGAIN;
0189     PUTBACK;
0190     FREETMPS;
0191     LEAVE;
0192 }
0193 
0194 static void define_event_symbols(struct tep_event *event,
0195                  const char *ev_name,
0196                  struct tep_print_arg *args)
0197 {
0198     if (args == NULL)
0199         return;
0200 
0201     switch (args->type) {
0202     case TEP_PRINT_NULL:
0203         break;
0204     case TEP_PRINT_ATOM:
0205         define_flag_value(ev_name, cur_field_name, "0",
0206                   args->atom.atom);
0207         zero_flag_atom = 0;
0208         break;
0209     case TEP_PRINT_FIELD:
0210         free(cur_field_name);
0211         cur_field_name = strdup(args->field.name);
0212         break;
0213     case TEP_PRINT_FLAGS:
0214         define_event_symbols(event, ev_name, args->flags.field);
0215         define_flag_field(ev_name, cur_field_name, args->flags.delim);
0216         define_flag_values(args->flags.flags, ev_name, cur_field_name);
0217         break;
0218     case TEP_PRINT_SYMBOL:
0219         define_event_symbols(event, ev_name, args->symbol.field);
0220         define_symbolic_field(ev_name, cur_field_name);
0221         define_symbolic_values(args->symbol.symbols, ev_name,
0222                        cur_field_name);
0223         break;
0224     case TEP_PRINT_HEX:
0225     case TEP_PRINT_HEX_STR:
0226         define_event_symbols(event, ev_name, args->hex.field);
0227         define_event_symbols(event, ev_name, args->hex.size);
0228         break;
0229     case TEP_PRINT_INT_ARRAY:
0230         define_event_symbols(event, ev_name, args->int_array.field);
0231         define_event_symbols(event, ev_name, args->int_array.count);
0232         define_event_symbols(event, ev_name, args->int_array.el_size);
0233         break;
0234     case TEP_PRINT_BSTRING:
0235     case TEP_PRINT_DYNAMIC_ARRAY:
0236     case TEP_PRINT_DYNAMIC_ARRAY_LEN:
0237     case TEP_PRINT_STRING:
0238     case TEP_PRINT_BITMASK:
0239         break;
0240     case TEP_PRINT_TYPE:
0241         define_event_symbols(event, ev_name, args->typecast.item);
0242         break;
0243     case TEP_PRINT_OP:
0244         if (strcmp(args->op.op, ":") == 0)
0245             zero_flag_atom = 1;
0246         define_event_symbols(event, ev_name, args->op.left);
0247         define_event_symbols(event, ev_name, args->op.right);
0248         break;
0249     case TEP_PRINT_FUNC:
0250     default:
0251         pr_err("Unsupported print arg type\n");
0252         /* we should warn... */
0253         return;
0254     }
0255 
0256     if (args->next)
0257         define_event_symbols(event, ev_name, args->next);
0258 }
0259 
0260 static SV *perl_process_callchain(struct perf_sample *sample,
0261                   struct evsel *evsel,
0262                   struct addr_location *al)
0263 {
0264     AV *list;
0265 
0266     list = newAV();
0267     if (!list)
0268         goto exit;
0269 
0270     if (!symbol_conf.use_callchain || !sample->callchain)
0271         goto exit;
0272 
0273     if (thread__resolve_callchain(al->thread, &callchain_cursor, evsel,
0274                       sample, NULL, NULL, scripting_max_stack) != 0) {
0275         pr_err("Failed to resolve callchain. Skipping\n");
0276         goto exit;
0277     }
0278     callchain_cursor_commit(&callchain_cursor);
0279 
0280 
0281     while (1) {
0282         HV *elem;
0283         struct callchain_cursor_node *node;
0284         node = callchain_cursor_current(&callchain_cursor);
0285         if (!node)
0286             break;
0287 
0288         elem = newHV();
0289         if (!elem)
0290             goto exit;
0291 
0292         if (!hv_stores(elem, "ip", newSVuv(node->ip))) {
0293             hv_undef(elem);
0294             goto exit;
0295         }
0296 
0297         if (node->ms.sym) {
0298             HV *sym = newHV();
0299             if (!sym) {
0300                 hv_undef(elem);
0301                 goto exit;
0302             }
0303             if (!hv_stores(sym, "start",   newSVuv(node->ms.sym->start)) ||
0304                 !hv_stores(sym, "end",     newSVuv(node->ms.sym->end)) ||
0305                 !hv_stores(sym, "binding", newSVuv(node->ms.sym->binding)) ||
0306                 !hv_stores(sym, "name",    newSVpvn(node->ms.sym->name,
0307                                 node->ms.sym->namelen)) ||
0308                 !hv_stores(elem, "sym",    newRV_noinc((SV*)sym))) {
0309                 hv_undef(sym);
0310                 hv_undef(elem);
0311                 goto exit;
0312             }
0313         }
0314 
0315         if (node->ms.map) {
0316             struct map *map = node->ms.map;
0317             const char *dsoname = "[unknown]";
0318             if (map && map->dso) {
0319                 if (symbol_conf.show_kernel_path && map->dso->long_name)
0320                     dsoname = map->dso->long_name;
0321                 else
0322                     dsoname = map->dso->name;
0323             }
0324             if (!hv_stores(elem, "dso", newSVpv(dsoname,0))) {
0325                 hv_undef(elem);
0326                 goto exit;
0327             }
0328         }
0329 
0330         callchain_cursor_advance(&callchain_cursor);
0331         av_push(list, newRV_noinc((SV*)elem));
0332     }
0333 
0334 exit:
0335     return newRV_noinc((SV*)list);
0336 }
0337 
0338 static void perl_process_tracepoint(struct perf_sample *sample,
0339                     struct evsel *evsel,
0340                     struct addr_location *al)
0341 {
0342     struct thread *thread = al->thread;
0343     struct tep_event *event = evsel->tp_format;
0344     struct tep_format_field *field;
0345     static char handler[256];
0346     unsigned long long val;
0347     unsigned long s, ns;
0348     int pid;
0349     int cpu = sample->cpu;
0350     void *data = sample->raw_data;
0351     unsigned long long nsecs = sample->time;
0352     const char *comm = thread__comm_str(thread);
0353 
0354     dSP;
0355 
0356     if (evsel->core.attr.type != PERF_TYPE_TRACEPOINT)
0357         return;
0358 
0359     if (!event) {
0360         pr_debug("ug! no event found for type %" PRIu64, (u64)evsel->core.attr.config);
0361         return;
0362     }
0363 
0364     pid = raw_field_value(event, "common_pid", data);
0365 
0366     sprintf(handler, "%s::%s", event->system, event->name);
0367 
0368     if (!test_and_set_bit(event->id, events_defined))
0369         define_event_symbols(event, handler, event->print_fmt.args);
0370 
0371     s = nsecs / NSEC_PER_SEC;
0372     ns = nsecs - s * NSEC_PER_SEC;
0373 
0374     ENTER;
0375     SAVETMPS;
0376     PUSHMARK(SP);
0377 
0378     XPUSHs(sv_2mortal(newSVpv(handler, 0)));
0379     XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
0380     XPUSHs(sv_2mortal(newSVuv(cpu)));
0381     XPUSHs(sv_2mortal(newSVuv(s)));
0382     XPUSHs(sv_2mortal(newSVuv(ns)));
0383     XPUSHs(sv_2mortal(newSViv(pid)));
0384     XPUSHs(sv_2mortal(newSVpv(comm, 0)));
0385     XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
0386 
0387     /* common fields other than pid can be accessed via xsub fns */
0388 
0389     for (field = event->format.fields; field; field = field->next) {
0390         if (field->flags & TEP_FIELD_IS_STRING) {
0391             int offset;
0392             if (field->flags & TEP_FIELD_IS_DYNAMIC) {
0393                 offset = *(int *)(data + field->offset);
0394                 offset &= 0xffff;
0395                 if (field->flags & TEP_FIELD_IS_RELATIVE)
0396                     offset += field->offset + field->size;
0397             } else
0398                 offset = field->offset;
0399             XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
0400         } else { /* FIELD_IS_NUMERIC */
0401             val = read_size(event, data + field->offset,
0402                     field->size);
0403             if (field->flags & TEP_FIELD_IS_SIGNED) {
0404                 XPUSHs(sv_2mortal(newSViv(val)));
0405             } else {
0406                 XPUSHs(sv_2mortal(newSVuv(val)));
0407             }
0408         }
0409     }
0410 
0411     PUTBACK;
0412 
0413     if (get_cv(handler, 0))
0414         call_pv(handler, G_SCALAR);
0415     else if (get_cv("main::trace_unhandled", 0)) {
0416         XPUSHs(sv_2mortal(newSVpv(handler, 0)));
0417         XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
0418         XPUSHs(sv_2mortal(newSVuv(cpu)));
0419         XPUSHs(sv_2mortal(newSVuv(nsecs)));
0420         XPUSHs(sv_2mortal(newSViv(pid)));
0421         XPUSHs(sv_2mortal(newSVpv(comm, 0)));
0422         XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
0423         call_pv("main::trace_unhandled", G_SCALAR);
0424     }
0425     SPAGAIN;
0426     PUTBACK;
0427     FREETMPS;
0428     LEAVE;
0429 }
0430 
0431 static void perl_process_event_generic(union perf_event *event,
0432                        struct perf_sample *sample,
0433                        struct evsel *evsel)
0434 {
0435     dSP;
0436 
0437     if (!get_cv("process_event", 0))
0438         return;
0439 
0440     ENTER;
0441     SAVETMPS;
0442     PUSHMARK(SP);
0443     XPUSHs(sv_2mortal(newSVpvn((const char *)event, event->header.size)));
0444     XPUSHs(sv_2mortal(newSVpvn((const char *)&evsel->core.attr, sizeof(evsel->core.attr))));
0445     XPUSHs(sv_2mortal(newSVpvn((const char *)sample, sizeof(*sample))));
0446     XPUSHs(sv_2mortal(newSVpvn((const char *)sample->raw_data, sample->raw_size)));
0447     PUTBACK;
0448     call_pv("process_event", G_SCALAR);
0449     SPAGAIN;
0450     PUTBACK;
0451     FREETMPS;
0452     LEAVE;
0453 }
0454 
0455 static void perl_process_event(union perf_event *event,
0456                    struct perf_sample *sample,
0457                    struct evsel *evsel,
0458                    struct addr_location *al,
0459                    struct addr_location *addr_al)
0460 {
0461     scripting_context__update(scripting_context, event, sample, evsel, al, addr_al);
0462     perl_process_tracepoint(sample, evsel, al);
0463     perl_process_event_generic(event, sample, evsel);
0464 }
0465 
0466 static void run_start_sub(void)
0467 {
0468     dSP; /* access to Perl stack */
0469     PUSHMARK(SP);
0470 
0471     if (get_cv("main::trace_begin", 0))
0472         call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
0473 }
0474 
0475 /*
0476  * Start trace script
0477  */
0478 static int perl_start_script(const char *script, int argc, const char **argv,
0479                  struct perf_session *session)
0480 {
0481     const char **command_line;
0482     int i, err = 0;
0483 
0484     scripting_context->session = session;
0485 
0486     command_line = malloc((argc + 2) * sizeof(const char *));
0487     command_line[0] = "";
0488     command_line[1] = script;
0489     for (i = 2; i < argc + 2; i++)
0490         command_line[i] = argv[i - 2];
0491 
0492     my_perl = perl_alloc();
0493     perl_construct(my_perl);
0494 
0495     if (perl_parse(my_perl, xs_init, argc + 2, (char **)command_line,
0496                (char **)NULL)) {
0497         err = -1;
0498         goto error;
0499     }
0500 
0501     if (perl_run(my_perl)) {
0502         err = -1;
0503         goto error;
0504     }
0505 
0506     if (SvTRUE(ERRSV)) {
0507         err = -1;
0508         goto error;
0509     }
0510 
0511     run_start_sub();
0512 
0513     free(command_line);
0514     return 0;
0515 error:
0516     perl_free(my_perl);
0517     free(command_line);
0518 
0519     return err;
0520 }
0521 
0522 static int perl_flush_script(void)
0523 {
0524     return 0;
0525 }
0526 
0527 /*
0528  * Stop trace script
0529  */
0530 static int perl_stop_script(void)
0531 {
0532     dSP; /* access to Perl stack */
0533     PUSHMARK(SP);
0534 
0535     if (get_cv("main::trace_end", 0))
0536         call_pv("main::trace_end", G_DISCARD | G_NOARGS);
0537 
0538     perl_destruct(my_perl);
0539     perl_free(my_perl);
0540 
0541     return 0;
0542 }
0543 
0544 static int perl_generate_script(struct tep_handle *pevent, const char *outfile)
0545 {
0546     int i, not_first, count, nr_events;
0547     struct tep_event **all_events;
0548     struct tep_event *event = NULL;
0549     struct tep_format_field *f;
0550     char fname[PATH_MAX];
0551     FILE *ofp;
0552 
0553     sprintf(fname, "%s.pl", outfile);
0554     ofp = fopen(fname, "w");
0555     if (ofp == NULL) {
0556         fprintf(stderr, "couldn't open %s\n", fname);
0557         return -1;
0558     }
0559 
0560     fprintf(ofp, "# perf script event handlers, "
0561         "generated by perf script -g perl\n");
0562 
0563     fprintf(ofp, "# Licensed under the terms of the GNU GPL"
0564         " License version 2\n\n");
0565 
0566     fprintf(ofp, "# The common_* event handler fields are the most useful "
0567         "fields common to\n");
0568 
0569     fprintf(ofp, "# all events.  They don't necessarily correspond to "
0570         "the 'common_*' fields\n");
0571 
0572     fprintf(ofp, "# in the format files.  Those fields not available as "
0573         "handler params can\n");
0574 
0575     fprintf(ofp, "# be retrieved using Perl functions of the form "
0576         "common_*($context).\n");
0577 
0578     fprintf(ofp, "# See Context.pm for the list of available "
0579         "functions.\n\n");
0580 
0581     fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
0582         "Perf-Trace-Util/lib\";\n");
0583 
0584     fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
0585     fprintf(ofp, "use Perf::Trace::Core;\n");
0586     fprintf(ofp, "use Perf::Trace::Context;\n");
0587     fprintf(ofp, "use Perf::Trace::Util;\n\n");
0588 
0589     fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
0590     fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n");
0591 
0592 
0593     fprintf(ofp, "\n\
0594 sub print_backtrace\n\
0595 {\n\
0596     my $callchain = shift;\n\
0597     for my $node (@$callchain)\n\
0598     {\n\
0599         if(exists $node->{sym})\n\
0600         {\n\
0601             printf( \"\\t[\\%%x] \\%%s\\n\", $node->{ip}, $node->{sym}{name});\n\
0602         }\n\
0603         else\n\
0604         {\n\
0605             printf( \"\\t[\\%%x]\\n\", $node{ip});\n\
0606         }\n\
0607     }\n\
0608 }\n\n\
0609 ");
0610 
0611     nr_events = tep_get_events_count(pevent);
0612     all_events = tep_list_events(pevent, TEP_EVENT_SORT_ID);
0613 
0614     for (i = 0; all_events && i < nr_events; i++) {
0615         event = all_events[i];
0616         fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
0617         fprintf(ofp, "\tmy (");
0618 
0619         fprintf(ofp, "$event_name, ");
0620         fprintf(ofp, "$context, ");
0621         fprintf(ofp, "$common_cpu, ");
0622         fprintf(ofp, "$common_secs, ");
0623         fprintf(ofp, "$common_nsecs,\n");
0624         fprintf(ofp, "\t    $common_pid, ");
0625         fprintf(ofp, "$common_comm, ");
0626         fprintf(ofp, "$common_callchain,\n\t    ");
0627 
0628         not_first = 0;
0629         count = 0;
0630 
0631         for (f = event->format.fields; f; f = f->next) {
0632             if (not_first++)
0633                 fprintf(ofp, ", ");
0634             if (++count % 5 == 0)
0635                 fprintf(ofp, "\n\t    ");
0636 
0637             fprintf(ofp, "$%s", f->name);
0638         }
0639         fprintf(ofp, ") = @_;\n\n");
0640 
0641         fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
0642             "$common_secs, $common_nsecs,\n\t             "
0643             "$common_pid, $common_comm, $common_callchain);\n\n");
0644 
0645         fprintf(ofp, "\tprintf(\"");
0646 
0647         not_first = 0;
0648         count = 0;
0649 
0650         for (f = event->format.fields; f; f = f->next) {
0651             if (not_first++)
0652                 fprintf(ofp, ", ");
0653             if (count && count % 4 == 0) {
0654                 fprintf(ofp, "\".\n\t       \"");
0655             }
0656             count++;
0657 
0658             fprintf(ofp, "%s=", f->name);
0659             if (f->flags & TEP_FIELD_IS_STRING ||
0660                 f->flags & TEP_FIELD_IS_FLAG ||
0661                 f->flags & TEP_FIELD_IS_SYMBOLIC)
0662                 fprintf(ofp, "%%s");
0663             else if (f->flags & TEP_FIELD_IS_SIGNED)
0664                 fprintf(ofp, "%%d");
0665             else
0666                 fprintf(ofp, "%%u");
0667         }
0668 
0669         fprintf(ofp, "\\n\",\n\t       ");
0670 
0671         not_first = 0;
0672         count = 0;
0673 
0674         for (f = event->format.fields; f; f = f->next) {
0675             if (not_first++)
0676                 fprintf(ofp, ", ");
0677 
0678             if (++count % 5 == 0)
0679                 fprintf(ofp, "\n\t       ");
0680 
0681             if (f->flags & TEP_FIELD_IS_FLAG) {
0682                 if ((count - 1) % 5 != 0) {
0683                     fprintf(ofp, "\n\t       ");
0684                     count = 4;
0685                 }
0686                 fprintf(ofp, "flag_str(\"");
0687                 fprintf(ofp, "%s::%s\", ", event->system,
0688                     event->name);
0689                 fprintf(ofp, "\"%s\", $%s)", f->name,
0690                     f->name);
0691             } else if (f->flags & TEP_FIELD_IS_SYMBOLIC) {
0692                 if ((count - 1) % 5 != 0) {
0693                     fprintf(ofp, "\n\t       ");
0694                     count = 4;
0695                 }
0696                 fprintf(ofp, "symbol_str(\"");
0697                 fprintf(ofp, "%s::%s\", ", event->system,
0698                     event->name);
0699                 fprintf(ofp, "\"%s\", $%s)", f->name,
0700                     f->name);
0701             } else
0702                 fprintf(ofp, "$%s", f->name);
0703         }
0704 
0705         fprintf(ofp, ");\n\n");
0706 
0707         fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
0708 
0709         fprintf(ofp, "}\n\n");
0710     }
0711 
0712     fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
0713         "$common_cpu, $common_secs, $common_nsecs,\n\t    "
0714         "$common_pid, $common_comm, $common_callchain) = @_;\n\n");
0715 
0716     fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
0717         "$common_secs, $common_nsecs,\n\t             $common_pid, "
0718         "$common_comm, $common_callchain);\n");
0719     fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
0720     fprintf(ofp, "}\n\n");
0721 
0722     fprintf(ofp, "sub print_header\n{\n"
0723         "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
0724         "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t       "
0725         "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}\n");
0726 
0727     fprintf(ofp,
0728         "\n# Packed byte string args of process_event():\n"
0729         "#\n"
0730         "# $event:\tunion perf_event\tutil/event.h\n"
0731         "# $attr:\tstruct perf_event_attr\tlinux/perf_event.h\n"
0732         "# $sample:\tstruct perf_sample\tutil/event.h\n"
0733         "# $raw_data:\tperf_sample->raw_data\tutil/event.h\n"
0734         "\n"
0735         "sub process_event\n"
0736         "{\n"
0737         "\tmy ($event, $attr, $sample, $raw_data) = @_;\n"
0738         "\n"
0739         "\tmy @event\t= unpack(\"LSS\", $event);\n"
0740         "\tmy @attr\t= unpack(\"LLQQQQQLLQQ\", $attr);\n"
0741         "\tmy @sample\t= unpack(\"QLLQQQQQLL\", $sample);\n"
0742         "\tmy @raw_data\t= unpack(\"C*\", $raw_data);\n"
0743         "\n"
0744         "\tuse Data::Dumper;\n"
0745         "\tprint Dumper \\@event, \\@attr, \\@sample, \\@raw_data;\n"
0746         "}\n");
0747 
0748     fclose(ofp);
0749 
0750     fprintf(stderr, "generated Perl script: %s\n", fname);
0751 
0752     return 0;
0753 }
0754 
0755 struct scripting_ops perl_scripting_ops = {
0756     .name = "Perl",
0757     .dirname = "perl",
0758     .start_script = perl_start_script,
0759     .flush_script = perl_flush_script,
0760     .stop_script = perl_stop_script,
0761     .process_event = perl_process_event,
0762     .generate_script = perl_generate_script,
0763 };
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated by the 2.1.0 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!