~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~

TOMOYO Linux Cross Reference
Linux/tools/perf/util/scripting-engines/trace-event-perl.c

Version: ~ [ linux-5.3-rc5 ] ~ [ linux-5.2.9 ] ~ [ linux-5.1.21 ] ~ [ linux-5.0.21 ] ~ [ linux-4.20.17 ] ~ [ linux-4.19.67 ] ~ [ linux-4.18.20 ] ~ [ linux-4.17.19 ] ~ [ linux-4.16.18 ] ~ [ linux-4.15.18 ] ~ [ linux-4.14.139 ] ~ [ linux-4.13.16 ] ~ [ linux-4.12.14 ] ~ [ linux-4.11.12 ] ~ [ linux-4.10.17 ] ~ [ linux-4.9.189 ] ~ [ linux-4.8.17 ] ~ [ linux-4.7.10 ] ~ [ linux-4.6.7 ] ~ [ linux-4.5.7 ] ~ [ linux-4.4.189 ] ~ [ linux-4.3.6 ] ~ [ linux-4.2.8 ] ~ [ linux-4.1.52 ] ~ [ linux-4.0.9 ] ~ [ linux-3.19.8 ] ~ [ linux-3.18.140 ] ~ [ linux-3.17.8 ] ~ [ linux-3.16.72 ] ~ [ linux-3.15.10 ] ~ [ linux-3.14.79 ] ~ [ linux-3.13.11 ] ~ [ linux-3.12.74 ] ~ [ linux-3.11.10 ] ~ [ linux-3.10.108 ] ~ [ linux-3.9.11 ] ~ [ linux-3.8.13 ] ~ [ linux-3.7.10 ] ~ [ linux-3.6.11 ] ~ [ linux-3.5.7 ] ~ [ linux-3.4.113 ] ~ [ linux-3.3.8 ] ~ [ linux-3.2.102 ] ~ [ linux-3.1.10 ] ~ [ linux-3.0.101 ] ~ [ linux-2.6.32.71 ] ~ [ linux-2.6.0 ] ~ [ linux-2.4.37.11 ] ~ [ unix-v6-master ] ~ [ ccs-tools-1.8.5 ] ~ [ policy-sample ] ~
Architecture: ~ [ i386 ] ~ [ alpha ] ~ [ m68k ] ~ [ mips ] ~ [ ppc ] ~ [ sparc ] ~ [ sparc64 ] ~

  1 /*
  2  * trace-event-perl.  Feed perf script events to an embedded Perl interpreter.
  3  *
  4  * Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
  5  *
  6  *  This program is free software; you can redistribute it and/or modify
  7  *  it under the terms of the GNU General Public License as published by
  8  *  the Free Software Foundation; either version 2 of the License, or
  9  *  (at your option) any later version.
 10  *
 11  *  This program is distributed in the hope that it will be useful,
 12  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 13  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 14  *  GNU General Public License for more details.
 15  *
 16  *  You should have received a copy of the GNU General Public License
 17  *  along with this program; if not, write to the Free Software
 18  *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 19  *
 20  */
 21 
 22 #include <stdio.h>
 23 #include <stdlib.h>
 24 #include <string.h>
 25 #include <ctype.h>
 26 #include <errno.h>
 27 #include <linux/bitmap.h>
 28 
 29 #include "../util.h"
 30 #include <EXTERN.h>
 31 #include <perl.h>
 32 
 33 #include "../../perf.h"
 34 #include "../callchain.h"
 35 #include "../machine.h"
 36 #include "../thread.h"
 37 #include "../event.h"
 38 #include "../trace-event.h"
 39 #include "../evsel.h"
 40 #include "../debug.h"
 41 
 42 void boot_Perf__Trace__Context(pTHX_ CV *cv);
 43 void boot_DynaLoader(pTHX_ CV *cv);
 44 typedef PerlInterpreter * INTERP;
 45 
 46 void xs_init(pTHX);
 47 
 48 void xs_init(pTHX)
 49 {
 50         const char *file = __FILE__;
 51         dXSUB_SYS;
 52 
 53         newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context,
 54               file);
 55         newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
 56 }
 57 
 58 INTERP my_perl;
 59 
 60 #define TRACE_EVENT_TYPE_MAX                            \
 61         ((1 << (sizeof(unsigned short) * 8)) - 1)
 62 
 63 static DECLARE_BITMAP(events_defined, TRACE_EVENT_TYPE_MAX);
 64 
 65 extern struct scripting_context *scripting_context;
 66 
 67 static char *cur_field_name;
 68 static int zero_flag_atom;
 69 
 70 static void define_symbolic_value(const char *ev_name,
 71                                   const char *field_name,
 72                                   const char *field_value,
 73                                   const char *field_str)
 74 {
 75         unsigned long long value;
 76         dSP;
 77 
 78         value = eval_flag(field_value);
 79 
 80         ENTER;
 81         SAVETMPS;
 82         PUSHMARK(SP);
 83 
 84         XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
 85         XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
 86         XPUSHs(sv_2mortal(newSVuv(value)));
 87         XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
 88 
 89         PUTBACK;
 90         if (get_cv("main::define_symbolic_value", 0))
 91                 call_pv("main::define_symbolic_value", G_SCALAR);
 92         SPAGAIN;
 93         PUTBACK;
 94         FREETMPS;
 95         LEAVE;
 96 }
 97 
 98 static void define_symbolic_values(struct print_flag_sym *field,
 99                                    const char *ev_name,
100                                    const char *field_name)
101 {
102         define_symbolic_value(ev_name, field_name, field->value, field->str);
103         if (field->next)
104                 define_symbolic_values(field->next, ev_name, field_name);
105 }
106 
107 static void define_symbolic_field(const char *ev_name,
108                                   const char *field_name)
109 {
110         dSP;
111 
112         ENTER;
113         SAVETMPS;
114         PUSHMARK(SP);
115 
116         XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
117         XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
118 
119         PUTBACK;
120         if (get_cv("main::define_symbolic_field", 0))
121                 call_pv("main::define_symbolic_field", G_SCALAR);
122         SPAGAIN;
123         PUTBACK;
124         FREETMPS;
125         LEAVE;
126 }
127 
128 static void define_flag_value(const char *ev_name,
129                               const char *field_name,
130                               const char *field_value,
131                               const char *field_str)
132 {
133         unsigned long long value;
134         dSP;
135 
136         value = eval_flag(field_value);
137 
138         ENTER;
139         SAVETMPS;
140         PUSHMARK(SP);
141 
142         XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
143         XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
144         XPUSHs(sv_2mortal(newSVuv(value)));
145         XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
146 
147         PUTBACK;
148         if (get_cv("main::define_flag_value", 0))
149                 call_pv("main::define_flag_value", G_SCALAR);
150         SPAGAIN;
151         PUTBACK;
152         FREETMPS;
153         LEAVE;
154 }
155 
156 static void define_flag_values(struct print_flag_sym *field,
157                                const char *ev_name,
158                                const char *field_name)
159 {
160         define_flag_value(ev_name, field_name, field->value, field->str);
161         if (field->next)
162                 define_flag_values(field->next, ev_name, field_name);
163 }
164 
165 static void define_flag_field(const char *ev_name,
166                               const char *field_name,
167                               const char *delim)
168 {
169         dSP;
170 
171         ENTER;
172         SAVETMPS;
173         PUSHMARK(SP);
174 
175         XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
176         XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
177         XPUSHs(sv_2mortal(newSVpv(delim, 0)));
178 
179         PUTBACK;
180         if (get_cv("main::define_flag_field", 0))
181                 call_pv("main::define_flag_field", G_SCALAR);
182         SPAGAIN;
183         PUTBACK;
184         FREETMPS;
185         LEAVE;
186 }
187 
188 static void define_event_symbols(struct event_format *event,
189                                  const char *ev_name,
190                                  struct print_arg *args)
191 {
192         if (args == NULL)
193                 return;
194 
195         switch (args->type) {
196         case PRINT_NULL:
197                 break;
198         case PRINT_ATOM:
199                 define_flag_value(ev_name, cur_field_name, "",
200                                   args->atom.atom);
201                 zero_flag_atom = 0;
202                 break;
203         case PRINT_FIELD:
204                 free(cur_field_name);
205                 cur_field_name = strdup(args->field.name);
206                 break;
207         case PRINT_FLAGS:
208                 define_event_symbols(event, ev_name, args->flags.field);
209                 define_flag_field(ev_name, cur_field_name, args->flags.delim);
210                 define_flag_values(args->flags.flags, ev_name, cur_field_name);
211                 break;
212         case PRINT_SYMBOL:
213                 define_event_symbols(event, ev_name, args->symbol.field);
214                 define_symbolic_field(ev_name, cur_field_name);
215                 define_symbolic_values(args->symbol.symbols, ev_name,
216                                        cur_field_name);
217                 break;
218         case PRINT_HEX:
219                 define_event_symbols(event, ev_name, args->hex.field);
220                 define_event_symbols(event, ev_name, args->hex.size);
221                 break;
222         case PRINT_INT_ARRAY:
223                 define_event_symbols(event, ev_name, args->int_array.field);
224                 define_event_symbols(event, ev_name, args->int_array.count);
225                 define_event_symbols(event, ev_name, args->int_array.el_size);
226                 break;
227         case PRINT_BSTRING:
228         case PRINT_DYNAMIC_ARRAY:
229         case PRINT_DYNAMIC_ARRAY_LEN:
230         case PRINT_STRING:
231         case PRINT_BITMASK:
232                 break;
233         case PRINT_TYPE:
234                 define_event_symbols(event, ev_name, args->typecast.item);
235                 break;
236         case PRINT_OP:
237                 if (strcmp(args->op.op, ":") == 0)
238                         zero_flag_atom = 1;
239                 define_event_symbols(event, ev_name, args->op.left);
240                 define_event_symbols(event, ev_name, args->op.right);
241                 break;
242         case PRINT_FUNC:
243         default:
244                 pr_err("Unsupported print arg type\n");
245                 /* we should warn... */
246                 return;
247         }
248 
249         if (args->next)
250                 define_event_symbols(event, ev_name, args->next);
251 }
252 
253 static SV *perl_process_callchain(struct perf_sample *sample,
254                                   struct perf_evsel *evsel,
255                                   struct addr_location *al)
256 {
257         AV *list;
258 
259         list = newAV();
260         if (!list)
261                 goto exit;
262 
263         if (!symbol_conf.use_callchain || !sample->callchain)
264                 goto exit;
265 
266         if (thread__resolve_callchain(al->thread, &callchain_cursor, evsel,
267                                       sample, NULL, NULL, scripting_max_stack) != 0) {
268                 pr_err("Failed to resolve callchain. Skipping\n");
269                 goto exit;
270         }
271         callchain_cursor_commit(&callchain_cursor);
272 
273 
274         while (1) {
275                 HV *elem;
276                 struct callchain_cursor_node *node;
277                 node = callchain_cursor_current(&callchain_cursor);
278                 if (!node)
279                         break;
280 
281                 elem = newHV();
282                 if (!elem)
283                         goto exit;
284 
285                 if (!hv_stores(elem, "ip", newSVuv(node->ip))) {
286                         hv_undef(elem);
287                         goto exit;
288                 }
289 
290                 if (node->sym) {
291                         HV *sym = newHV();
292                         if (!sym) {
293                                 hv_undef(elem);
294                                 goto exit;
295                         }
296                         if (!hv_stores(sym, "start",   newSVuv(node->sym->start)) ||
297                             !hv_stores(sym, "end",     newSVuv(node->sym->end)) ||
298                             !hv_stores(sym, "binding", newSVuv(node->sym->binding)) ||
299                             !hv_stores(sym, "name",    newSVpvn(node->sym->name,
300                                                                 node->sym->namelen)) ||
301                             !hv_stores(elem, "sym",    newRV_noinc((SV*)sym))) {
302                                 hv_undef(sym);
303                                 hv_undef(elem);
304                                 goto exit;
305                         }
306                 }
307 
308                 if (node->map) {
309                         struct map *map = node->map;
310                         const char *dsoname = "[unknown]";
311                         if (map && map->dso && (map->dso->name || map->dso->long_name)) {
312                                 if (symbol_conf.show_kernel_path && map->dso->long_name)
313                                         dsoname = map->dso->long_name;
314                                 else if (map->dso->name)
315                                         dsoname = map->dso->name;
316                         }
317                         if (!hv_stores(elem, "dso", newSVpv(dsoname,0))) {
318                                 hv_undef(elem);
319                                 goto exit;
320                         }
321                 }
322 
323                 callchain_cursor_advance(&callchain_cursor);
324                 av_push(list, newRV_noinc((SV*)elem));
325         }
326 
327 exit:
328         return newRV_noinc((SV*)list);
329 }
330 
331 static void perl_process_tracepoint(struct perf_sample *sample,
332                                     struct perf_evsel *evsel,
333                                     struct addr_location *al)
334 {
335         struct thread *thread = al->thread;
336         struct event_format *event = evsel->tp_format;
337         struct format_field *field;
338         static char handler[256];
339         unsigned long long val;
340         unsigned long s, ns;
341         int pid;
342         int cpu = sample->cpu;
343         void *data = sample->raw_data;
344         unsigned long long nsecs = sample->time;
345         const char *comm = thread__comm_str(thread);
346 
347         dSP;
348 
349         if (evsel->attr.type != PERF_TYPE_TRACEPOINT)
350                 return;
351 
352         if (!event)
353                 die("ug! no event found for type %" PRIu64, (u64)evsel->attr.config);
354 
355         pid = raw_field_value(event, "common_pid", data);
356 
357         sprintf(handler, "%s::%s", event->system, event->name);
358 
359         if (!test_and_set_bit(event->id, events_defined))
360                 define_event_symbols(event, handler, event->print_fmt.args);
361 
362         s = nsecs / NSECS_PER_SEC;
363         ns = nsecs - s * NSECS_PER_SEC;
364 
365         scripting_context->event_data = data;
366         scripting_context->pevent = evsel->tp_format->pevent;
367 
368         ENTER;
369         SAVETMPS;
370         PUSHMARK(SP);
371 
372         XPUSHs(sv_2mortal(newSVpv(handler, 0)));
373         XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
374         XPUSHs(sv_2mortal(newSVuv(cpu)));
375         XPUSHs(sv_2mortal(newSVuv(s)));
376         XPUSHs(sv_2mortal(newSVuv(ns)));
377         XPUSHs(sv_2mortal(newSViv(pid)));
378         XPUSHs(sv_2mortal(newSVpv(comm, 0)));
379         XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
380 
381         /* common fields other than pid can be accessed via xsub fns */
382 
383         for (field = event->format.fields; field; field = field->next) {
384                 if (field->flags & FIELD_IS_STRING) {
385                         int offset;
386                         if (field->flags & FIELD_IS_DYNAMIC) {
387                                 offset = *(int *)(data + field->offset);
388                                 offset &= 0xffff;
389                         } else
390                                 offset = field->offset;
391                         XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
392                 } else { /* FIELD_IS_NUMERIC */
393                         val = read_size(event, data + field->offset,
394                                         field->size);
395                         if (field->flags & FIELD_IS_SIGNED) {
396                                 XPUSHs(sv_2mortal(newSViv(val)));
397                         } else {
398                                 XPUSHs(sv_2mortal(newSVuv(val)));
399                         }
400                 }
401         }
402 
403         PUTBACK;
404 
405         if (get_cv(handler, 0))
406                 call_pv(handler, G_SCALAR);
407         else if (get_cv("main::trace_unhandled", 0)) {
408                 XPUSHs(sv_2mortal(newSVpv(handler, 0)));
409                 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
410                 XPUSHs(sv_2mortal(newSVuv(cpu)));
411                 XPUSHs(sv_2mortal(newSVuv(nsecs)));
412                 XPUSHs(sv_2mortal(newSViv(pid)));
413                 XPUSHs(sv_2mortal(newSVpv(comm, 0)));
414                 XPUSHs(sv_2mortal(perl_process_callchain(sample, evsel, al)));
415                 call_pv("main::trace_unhandled", G_SCALAR);
416         }
417         SPAGAIN;
418         PUTBACK;
419         FREETMPS;
420         LEAVE;
421 }
422 
423 static void perl_process_event_generic(union perf_event *event,
424                                        struct perf_sample *sample,
425                                        struct perf_evsel *evsel)
426 {
427         dSP;
428 
429         if (!get_cv("process_event", 0))
430                 return;
431 
432         ENTER;
433         SAVETMPS;
434         PUSHMARK(SP);
435         XPUSHs(sv_2mortal(newSVpvn((const char *)event, event->header.size)));
436         XPUSHs(sv_2mortal(newSVpvn((const char *)&evsel->attr, sizeof(evsel->attr))));
437         XPUSHs(sv_2mortal(newSVpvn((const char *)sample, sizeof(*sample))));
438         XPUSHs(sv_2mortal(newSVpvn((const char *)sample->raw_data, sample->raw_size)));
439         PUTBACK;
440         call_pv("process_event", G_SCALAR);
441         SPAGAIN;
442         PUTBACK;
443         FREETMPS;
444         LEAVE;
445 }
446 
447 static void perl_process_event(union perf_event *event,
448                                struct perf_sample *sample,
449                                struct perf_evsel *evsel,
450                                struct addr_location *al)
451 {
452         perl_process_tracepoint(sample, evsel, al);
453         perl_process_event_generic(event, sample, evsel);
454 }
455 
456 static void run_start_sub(void)
457 {
458         dSP; /* access to Perl stack */
459         PUSHMARK(SP);
460 
461         if (get_cv("main::trace_begin", 0))
462                 call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
463 }
464 
465 /*
466  * Start trace script
467  */
468 static int perl_start_script(const char *script, int argc, const char **argv)
469 {
470         const char **command_line;
471         int i, err = 0;
472 
473         command_line = malloc((argc + 2) * sizeof(const char *));
474         command_line[0] = "";
475         command_line[1] = script;
476         for (i = 2; i < argc + 2; i++)
477                 command_line[i] = argv[i - 2];
478 
479         my_perl = perl_alloc();
480         perl_construct(my_perl);
481 
482         if (perl_parse(my_perl, xs_init, argc + 2, (char **)command_line,
483                        (char **)NULL)) {
484                 err = -1;
485                 goto error;
486         }
487 
488         if (perl_run(my_perl)) {
489                 err = -1;
490                 goto error;
491         }
492 
493         if (SvTRUE(ERRSV)) {
494                 err = -1;
495                 goto error;
496         }
497 
498         run_start_sub();
499 
500         free(command_line);
501         return 0;
502 error:
503         perl_free(my_perl);
504         free(command_line);
505 
506         return err;
507 }
508 
509 static int perl_flush_script(void)
510 {
511         return 0;
512 }
513 
514 /*
515  * Stop trace script
516  */
517 static int perl_stop_script(void)
518 {
519         dSP; /* access to Perl stack */
520         PUSHMARK(SP);
521 
522         if (get_cv("main::trace_end", 0))
523                 call_pv("main::trace_end", G_DISCARD | G_NOARGS);
524 
525         perl_destruct(my_perl);
526         perl_free(my_perl);
527 
528         return 0;
529 }
530 
531 static int perl_generate_script(struct pevent *pevent, const char *outfile)
532 {
533         struct event_format *event = NULL;
534         struct format_field *f;
535         char fname[PATH_MAX];
536         int not_first, count;
537         FILE *ofp;
538 
539         sprintf(fname, "%s.pl", outfile);
540         ofp = fopen(fname, "w");
541         if (ofp == NULL) {
542                 fprintf(stderr, "couldn't open %s\n", fname);
543                 return -1;
544         }
545 
546         fprintf(ofp, "# perf script event handlers, "
547                 "generated by perf script -g perl\n");
548 
549         fprintf(ofp, "# Licensed under the terms of the GNU GPL"
550                 " License version 2\n\n");
551 
552         fprintf(ofp, "# The common_* event handler fields are the most useful "
553                 "fields common to\n");
554 
555         fprintf(ofp, "# all events.  They don't necessarily correspond to "
556                 "the 'common_*' fields\n");
557 
558         fprintf(ofp, "# in the format files.  Those fields not available as "
559                 "handler params can\n");
560 
561         fprintf(ofp, "# be retrieved using Perl functions of the form "
562                 "common_*($context).\n");
563 
564         fprintf(ofp, "# See Context.pm for the list of available "
565                 "functions.\n\n");
566 
567         fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
568                 "Perf-Trace-Util/lib\";\n");
569 
570         fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
571         fprintf(ofp, "use Perf::Trace::Core;\n");
572         fprintf(ofp, "use Perf::Trace::Context;\n");
573         fprintf(ofp, "use Perf::Trace::Util;\n\n");
574 
575         fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
576         fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n");
577 
578 
579         fprintf(ofp, "\n\
580 sub print_backtrace\n\
581 {\n\
582         my $callchain = shift;\n\
583         for my $node (@$callchain)\n\
584         {\n\
585                 if(exists $node->{sym})\n\
586                 {\n\
587                         printf( \"\\t[\\%%x] \\%%s\\n\", $node->{ip}, $node->{sym}{name});\n\
588                 }\n\
589                 else\n\
590                 {\n\
591                         printf( \"\\t[\\%%x]\\n\", $node{ip});\n\
592                 }\n\
593         }\n\
594 }\n\n\
595 ");
596 
597 
598         while ((event = trace_find_next_event(pevent, event))) {
599                 fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
600                 fprintf(ofp, "\tmy (");
601 
602                 fprintf(ofp, "$event_name, ");
603                 fprintf(ofp, "$context, ");
604                 fprintf(ofp, "$common_cpu, ");
605                 fprintf(ofp, "$common_secs, ");
606                 fprintf(ofp, "$common_nsecs,\n");
607                 fprintf(ofp, "\t    $common_pid, ");
608                 fprintf(ofp, "$common_comm, ");
609                 fprintf(ofp, "$common_callchain,\n\t    ");
610 
611                 not_first = 0;
612                 count = 0;
613 
614                 for (f = event->format.fields; f; f = f->next) {
615                         if (not_first++)
616                                 fprintf(ofp, ", ");
617                         if (++count % 5 == 0)
618                                 fprintf(ofp, "\n\t    ");
619 
620                         fprintf(ofp, "$%s", f->name);
621                 }
622                 fprintf(ofp, ") = @_;\n\n");
623 
624                 fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
625                         "$common_secs, $common_nsecs,\n\t             "
626                         "$common_pid, $common_comm, $common_callchain);\n\n");
627 
628                 fprintf(ofp, "\tprintf(\"");
629 
630                 not_first = 0;
631                 count = 0;
632 
633                 for (f = event->format.fields; f; f = f->next) {
634                         if (not_first++)
635                                 fprintf(ofp, ", ");
636                         if (count && count % 4 == 0) {
637                                 fprintf(ofp, "\".\n\t       \"");
638                         }
639                         count++;
640 
641                         fprintf(ofp, "%s=", f->name);
642                         if (f->flags & FIELD_IS_STRING ||
643                             f->flags & FIELD_IS_FLAG ||
644                             f->flags & FIELD_IS_SYMBOLIC)
645                                 fprintf(ofp, "%%s");
646                         else if (f->flags & FIELD_IS_SIGNED)
647                                 fprintf(ofp, "%%d");
648                         else
649                                 fprintf(ofp, "%%u");
650                 }
651 
652                 fprintf(ofp, "\\n\",\n\t       ");
653 
654                 not_first = 0;
655                 count = 0;
656 
657                 for (f = event->format.fields; f; f = f->next) {
658                         if (not_first++)
659                                 fprintf(ofp, ", ");
660 
661                         if (++count % 5 == 0)
662                                 fprintf(ofp, "\n\t       ");
663 
664                         if (f->flags & FIELD_IS_FLAG) {
665                                 if ((count - 1) % 5 != 0) {
666                                         fprintf(ofp, "\n\t       ");
667                                         count = 4;
668                                 }
669                                 fprintf(ofp, "flag_str(\"");
670                                 fprintf(ofp, "%s::%s\", ", event->system,
671                                         event->name);
672                                 fprintf(ofp, "\"%s\", $%s)", f->name,
673                                         f->name);
674                         } else if (f->flags & FIELD_IS_SYMBOLIC) {
675                                 if ((count - 1) % 5 != 0) {
676                                         fprintf(ofp, "\n\t       ");
677                                         count = 4;
678                                 }
679                                 fprintf(ofp, "symbol_str(\"");
680                                 fprintf(ofp, "%s::%s\", ", event->system,
681                                         event->name);
682                                 fprintf(ofp, "\"%s\", $%s)", f->name,
683                                         f->name);
684                         } else
685                                 fprintf(ofp, "$%s", f->name);
686                 }
687 
688                 fprintf(ofp, ");\n\n");
689 
690                 fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
691 
692                 fprintf(ofp, "}\n\n");
693         }
694 
695         fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
696                 "$common_cpu, $common_secs, $common_nsecs,\n\t    "
697                 "$common_pid, $common_comm, $common_callchain) = @_;\n\n");
698 
699         fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
700                 "$common_secs, $common_nsecs,\n\t             $common_pid, "
701                 "$common_comm, $common_callchain);\n");
702         fprintf(ofp, "\tprint_backtrace($common_callchain);\n");
703         fprintf(ofp, "}\n\n");
704 
705         fprintf(ofp, "sub print_header\n{\n"
706                 "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
707                 "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t       "
708                 "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}\n");
709 
710         fprintf(ofp,
711                 "\n# Packed byte string args of process_event():\n"
712                 "#\n"
713                 "# $event:\tunion perf_event\tutil/event.h\n"
714                 "# $attr:\tstruct perf_event_attr\tlinux/perf_event.h\n"
715                 "# $sample:\tstruct perf_sample\tutil/event.h\n"
716                 "# $raw_data:\tperf_sample->raw_data\tutil/event.h\n"
717                 "\n"
718                 "sub process_event\n"
719                 "{\n"
720                 "\tmy ($event, $attr, $sample, $raw_data) = @_;\n"
721                 "\n"
722                 "\tmy @event\t= unpack(\"LSS\", $event);\n"
723                 "\tmy @attr\t= unpack(\"LLQQQQQLLQQ\", $attr);\n"
724                 "\tmy @sample\t= unpack(\"QLLQQQQQLL\", $sample);\n"
725                 "\tmy @raw_data\t= unpack(\"C*\", $raw_data);\n"
726                 "\n"
727                 "\tuse Data::Dumper;\n"
728                 "\tprint Dumper \\@event, \\@attr, \\@sample, \\@raw_data;\n"
729                 "}\n");
730 
731         fclose(ofp);
732 
733         fprintf(stderr, "generated Perl script: %s\n", fname);
734 
735         return 0;
736 }
737 
738 struct scripting_ops perl_scripting_ops = {
739         .name = "Perl",
740         .start_script = perl_start_script,
741         .flush_script = perl_flush_script,
742         .stop_script = perl_stop_script,
743         .process_event = perl_process_event,
744         .generate_script = perl_generate_script,
745 };
746 

~ [ source navigation ] ~ [ diff markup ] ~ [ identifier search ] ~

kernel.org | git.kernel.org | LWN.net | Project Home | Wiki (Japanese) | Wiki (English) | SVN repository | Mail admin

Linux® is a registered trademark of Linus Torvalds in the United States and other countries.
TOMOYO® is a registered trademark of NTT DATA CORPORATION.

osdn.jp