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