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 28 #include "../../perf.h" 29 #include "../util.h" 30 #include "../thread.h" 31 #include "../event.h" 32 #include "../trace-event.h" 33 #include "../evsel.h" 34 35 #include <EXTERN.h> 36 #include <perl.h> 37 38 void boot_Perf__Trace__Context(pTHX_ CV *cv); 39 void boot_DynaLoader(pTHX_ CV *cv); 40 typedef PerlInterpreter * INTERP; 41 42 void xs_init(pTHX); 43 44 void xs_init(pTHX) 45 { 46 const char *file = __FILE__; 47 dXSUB_SYS; 48 49 newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context, 50 file); 51 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file); 52 } 53 54 INTERP my_perl; 55 56 #define FTRACE_MAX_EVENT \ 57 ((1 << (sizeof(unsigned short) * 8)) - 1) 58 59 struct event *events[FTRACE_MAX_EVENT]; 60 61 extern struct scripting_context *scripting_context; 62 63 static char *cur_field_name; 64 static int zero_flag_atom; 65 66 static void define_symbolic_value(const char *ev_name, 67 const char *field_name, 68 const char *field_value, 69 const char *field_str) 70 { 71 unsigned long long value; 72 dSP; 73 74 value = eval_flag(field_value); 75 76 ENTER; 77 SAVETMPS; 78 PUSHMARK(SP); 79 80 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 81 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 82 XPUSHs(sv_2mortal(newSVuv(value))); 83 XPUSHs(sv_2mortal(newSVpv(field_str, 0))); 84 85 PUTBACK; 86 if (get_cv("main::define_symbolic_value", 0)) 87 call_pv("main::define_symbolic_value", G_SCALAR); 88 SPAGAIN; 89 PUTBACK; 90 FREETMPS; 91 LEAVE; 92 } 93 94 static void define_symbolic_values(struct print_flag_sym *field, 95 const char *ev_name, 96 const char *field_name) 97 { 98 define_symbolic_value(ev_name, field_name, field->value, field->str); 99 if (field->next) 100 define_symbolic_values(field->next, ev_name, field_name); 101 } 102 103 static void define_symbolic_field(const char *ev_name, 104 const char *field_name) 105 { 106 dSP; 107 108 ENTER; 109 SAVETMPS; 110 PUSHMARK(SP); 111 112 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 113 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 114 115 PUTBACK; 116 if (get_cv("main::define_symbolic_field", 0)) 117 call_pv("main::define_symbolic_field", G_SCALAR); 118 SPAGAIN; 119 PUTBACK; 120 FREETMPS; 121 LEAVE; 122 } 123 124 static void define_flag_value(const char *ev_name, 125 const char *field_name, 126 const char *field_value, 127 const char *field_str) 128 { 129 unsigned long long value; 130 dSP; 131 132 value = eval_flag(field_value); 133 134 ENTER; 135 SAVETMPS; 136 PUSHMARK(SP); 137 138 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 139 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 140 XPUSHs(sv_2mortal(newSVuv(value))); 141 XPUSHs(sv_2mortal(newSVpv(field_str, 0))); 142 143 PUTBACK; 144 if (get_cv("main::define_flag_value", 0)) 145 call_pv("main::define_flag_value", G_SCALAR); 146 SPAGAIN; 147 PUTBACK; 148 FREETMPS; 149 LEAVE; 150 } 151 152 static void define_flag_values(struct print_flag_sym *field, 153 const char *ev_name, 154 const char *field_name) 155 { 156 define_flag_value(ev_name, field_name, field->value, field->str); 157 if (field->next) 158 define_flag_values(field->next, ev_name, field_name); 159 } 160 161 static void define_flag_field(const char *ev_name, 162 const char *field_name, 163 const char *delim) 164 { 165 dSP; 166 167 ENTER; 168 SAVETMPS; 169 PUSHMARK(SP); 170 171 XPUSHs(sv_2mortal(newSVpv(ev_name, 0))); 172 XPUSHs(sv_2mortal(newSVpv(field_name, 0))); 173 XPUSHs(sv_2mortal(newSVpv(delim, 0))); 174 175 PUTBACK; 176 if (get_cv("main::define_flag_field", 0)) 177 call_pv("main::define_flag_field", G_SCALAR); 178 SPAGAIN; 179 PUTBACK; 180 FREETMPS; 181 LEAVE; 182 } 183 184 static void define_event_symbols(struct event *event, 185 const char *ev_name, 186 struct print_arg *args) 187 { 188 switch (args->type) { 189 case PRINT_NULL: 190 break; 191 case PRINT_ATOM: 192 define_flag_value(ev_name, cur_field_name, "0", 193 args->atom.atom); 194 zero_flag_atom = 0; 195 break; 196 case PRINT_FIELD: 197 if (cur_field_name) 198 free(cur_field_name); 199 cur_field_name = strdup(args->field.name); 200 break; 201 case PRINT_FLAGS: 202 define_event_symbols(event, ev_name, args->flags.field); 203 define_flag_field(ev_name, cur_field_name, args->flags.delim); 204 define_flag_values(args->flags.flags, ev_name, cur_field_name); 205 break; 206 case PRINT_SYMBOL: 207 define_event_symbols(event, ev_name, args->symbol.field); 208 define_symbolic_field(ev_name, cur_field_name); 209 define_symbolic_values(args->symbol.symbols, ev_name, 210 cur_field_name); 211 break; 212 case PRINT_STRING: 213 break; 214 case PRINT_TYPE: 215 define_event_symbols(event, ev_name, args->typecast.item); 216 break; 217 case PRINT_OP: 218 if (strcmp(args->op.op, ":") == 0) 219 zero_flag_atom = 1; 220 define_event_symbols(event, ev_name, args->op.left); 221 define_event_symbols(event, ev_name, args->op.right); 222 break; 223 default: 224 /* we should warn... */ 225 return; 226 } 227 228 if (args->next) 229 define_event_symbols(event, ev_name, args->next); 230 } 231 232 static inline struct event *find_cache_event(int type) 233 { 234 static char ev_name[256]; 235 struct event *event; 236 237 if (events[type]) 238 return events[type]; 239 240 events[type] = event = trace_find_event(type); 241 if (!event) 242 return NULL; 243 244 sprintf(ev_name, "%s::%s", event->system, event->name); 245 246 define_event_symbols(event, ev_name, event->print_fmt.args); 247 248 return event; 249 } 250 251 static void perl_process_tracepoint(union perf_event *pevent __unused, 252 struct perf_sample *sample, 253 struct perf_evsel *evsel, 254 struct machine *machine __unused, 255 struct thread *thread) 256 { 257 struct format_field *field; 258 static char handler[256]; 259 unsigned long long val; 260 unsigned long s, ns; 261 struct event *event; 262 int type; 263 int pid; 264 int cpu = sample->cpu; 265 void *data = sample->raw_data; 266 unsigned long long nsecs = sample->time; 267 char *comm = thread->comm; 268 269 dSP; 270 271 if (evsel->attr.type != PERF_TYPE_TRACEPOINT) 272 return; 273 274 type = trace_parse_common_type(data); 275 276 event = find_cache_event(type); 277 if (!event) 278 die("ug! no event found for type %d", type); 279 280 pid = trace_parse_common_pid(data); 281 282 sprintf(handler, "%s::%s", event->system, event->name); 283 284 s = nsecs / NSECS_PER_SEC; 285 ns = nsecs - s * NSECS_PER_SEC; 286 287 scripting_context->event_data = data; 288 289 ENTER; 290 SAVETMPS; 291 PUSHMARK(SP); 292 293 XPUSHs(sv_2mortal(newSVpv(handler, 0))); 294 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context)))); 295 XPUSHs(sv_2mortal(newSVuv(cpu))); 296 XPUSHs(sv_2mortal(newSVuv(s))); 297 XPUSHs(sv_2mortal(newSVuv(ns))); 298 XPUSHs(sv_2mortal(newSViv(pid))); 299 XPUSHs(sv_2mortal(newSVpv(comm, 0))); 300 301 /* common fields other than pid can be accessed via xsub fns */ 302 303 for (field = event->format.fields; field; field = field->next) { 304 if (field->flags & FIELD_IS_STRING) { 305 int offset; 306 if (field->flags & FIELD_IS_DYNAMIC) { 307 offset = *(int *)(data + field->offset); 308 offset &= 0xffff; 309 } else 310 offset = field->offset; 311 XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0))); 312 } else { /* FIELD_IS_NUMERIC */ 313 val = read_size(data + field->offset, field->size); 314 if (field->flags & FIELD_IS_SIGNED) { 315 XPUSHs(sv_2mortal(newSViv(val))); 316 } else { 317 XPUSHs(sv_2mortal(newSVuv(val))); 318 } 319 } 320 } 321 322 PUTBACK; 323 324 if (get_cv(handler, 0)) 325 call_pv(handler, G_SCALAR); 326 else if (get_cv("main::trace_unhandled", 0)) { 327 XPUSHs(sv_2mortal(newSVpv(handler, 0))); 328 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context)))); 329 XPUSHs(sv_2mortal(newSVuv(cpu))); 330 XPUSHs(sv_2mortal(newSVuv(nsecs))); 331 XPUSHs(sv_2mortal(newSViv(pid))); 332 XPUSHs(sv_2mortal(newSVpv(comm, 0))); 333 call_pv("main::trace_unhandled", G_SCALAR); 334 } 335 SPAGAIN; 336 PUTBACK; 337 FREETMPS; 338 LEAVE; 339 } 340 341 static void perl_process_event_generic(union perf_event *pevent __unused, 342 struct perf_sample *sample, 343 struct perf_evsel *evsel __unused, 344 struct machine *machine __unused, 345 struct thread *thread __unused) 346 { 347 dSP; 348 349 if (!get_cv("process_event", 0)) 350 return; 351 352 ENTER; 353 SAVETMPS; 354 PUSHMARK(SP); 355 XPUSHs(sv_2mortal(newSVpvn((const char *)pevent, pevent->header.size))); 356 XPUSHs(sv_2mortal(newSVpvn((const char *)&evsel->attr, sizeof(evsel->attr)))); 357 XPUSHs(sv_2mortal(newSVpvn((const char *)sample, sizeof(*sample)))); 358 XPUSHs(sv_2mortal(newSVpvn((const char *)sample->raw_data, sample->raw_size))); 359 PUTBACK; 360 call_pv("process_event", G_SCALAR); 361 SPAGAIN; 362 PUTBACK; 363 FREETMPS; 364 LEAVE; 365 } 366 367 static void perl_process_event(union perf_event *pevent, 368 struct perf_sample *sample, 369 struct perf_evsel *evsel, 370 struct machine *machine, 371 struct thread *thread) 372 { 373 perl_process_tracepoint(pevent, sample, evsel, machine, thread); 374 perl_process_event_generic(pevent, sample, evsel, machine, thread); 375 } 376 377 static void run_start_sub(void) 378 { 379 dSP; /* access to Perl stack */ 380 PUSHMARK(SP); 381 382 if (get_cv("main::trace_begin", 0)) 383 call_pv("main::trace_begin", G_DISCARD | G_NOARGS); 384 } 385 386 /* 387 * Start trace script 388 */ 389 static int perl_start_script(const char *script, int argc, const char **argv) 390 { 391 const char **command_line; 392 int i, err = 0; 393 394 command_line = malloc((argc + 2) * sizeof(const char *)); 395 command_line[0] = ""; 396 command_line[1] = script; 397 for (i = 2; i < argc + 2; i++) 398 command_line[i] = argv[i - 2]; 399 400 my_perl = perl_alloc(); 401 perl_construct(my_perl); 402 403 if (perl_parse(my_perl, xs_init, argc + 2, (char **)command_line, 404 (char **)NULL)) { 405 err = -1; 406 goto error; 407 } 408 409 if (perl_run(my_perl)) { 410 err = -1; 411 goto error; 412 } 413 414 if (SvTRUE(ERRSV)) { 415 err = -1; 416 goto error; 417 } 418 419 run_start_sub(); 420 421 free(command_line); 422 return 0; 423 error: 424 perl_free(my_perl); 425 free(command_line); 426 427 return err; 428 } 429 430 /* 431 * Stop trace script 432 */ 433 static int perl_stop_script(void) 434 { 435 dSP; /* access to Perl stack */ 436 PUSHMARK(SP); 437 438 if (get_cv("main::trace_end", 0)) 439 call_pv("main::trace_end", G_DISCARD | G_NOARGS); 440 441 perl_destruct(my_perl); 442 perl_free(my_perl); 443 444 return 0; 445 } 446 447 static int perl_generate_script(const char *outfile) 448 { 449 struct event *event = NULL; 450 struct format_field *f; 451 char fname[PATH_MAX]; 452 int not_first, count; 453 FILE *ofp; 454 455 sprintf(fname, "%s.pl", outfile); 456 ofp = fopen(fname, "w"); 457 if (ofp == NULL) { 458 fprintf(stderr, "couldn't open %s\n", fname); 459 return -1; 460 } 461 462 fprintf(ofp, "# perf script event handlers, " 463 "generated by perf script -g perl\n"); 464 465 fprintf(ofp, "# Licensed under the terms of the GNU GPL" 466 " License version 2\n\n"); 467 468 fprintf(ofp, "# The common_* event handler fields are the most useful " 469 "fields common to\n"); 470 471 fprintf(ofp, "# all events. They don't necessarily correspond to " 472 "the 'common_*' fields\n"); 473 474 fprintf(ofp, "# in the format files. Those fields not available as " 475 "handler params can\n"); 476 477 fprintf(ofp, "# be retrieved using Perl functions of the form " 478 "common_*($context).\n"); 479 480 fprintf(ofp, "# See Context.pm for the list of available " 481 "functions.\n\n"); 482 483 fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/" 484 "Perf-Trace-Util/lib\";\n"); 485 486 fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n"); 487 fprintf(ofp, "use Perf::Trace::Core;\n"); 488 fprintf(ofp, "use Perf::Trace::Context;\n"); 489 fprintf(ofp, "use Perf::Trace::Util;\n\n"); 490 491 fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n"); 492 fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n"); 493 494 while ((event = trace_find_next_event(event))) { 495 fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name); 496 fprintf(ofp, "\tmy ("); 497 498 fprintf(ofp, "$event_name, "); 499 fprintf(ofp, "$context, "); 500 fprintf(ofp, "$common_cpu, "); 501 fprintf(ofp, "$common_secs, "); 502 fprintf(ofp, "$common_nsecs,\n"); 503 fprintf(ofp, "\t $common_pid, "); 504 fprintf(ofp, "$common_comm,\n\t "); 505 506 not_first = 0; 507 count = 0; 508 509 for (f = event->format.fields; f; f = f->next) { 510 if (not_first++) 511 fprintf(ofp, ", "); 512 if (++count % 5 == 0) 513 fprintf(ofp, "\n\t "); 514 515 fprintf(ofp, "$%s", f->name); 516 } 517 fprintf(ofp, ") = @_;\n\n"); 518 519 fprintf(ofp, "\tprint_header($event_name, $common_cpu, " 520 "$common_secs, $common_nsecs,\n\t " 521 "$common_pid, $common_comm);\n\n"); 522 523 fprintf(ofp, "\tprintf(\""); 524 525 not_first = 0; 526 count = 0; 527 528 for (f = event->format.fields; f; f = f->next) { 529 if (not_first++) 530 fprintf(ofp, ", "); 531 if (count && count % 4 == 0) { 532 fprintf(ofp, "\".\n\t \""); 533 } 534 count++; 535 536 fprintf(ofp, "%s=", f->name); 537 if (f->flags & FIELD_IS_STRING || 538 f->flags & FIELD_IS_FLAG || 539 f->flags & FIELD_IS_SYMBOLIC) 540 fprintf(ofp, "%%s"); 541 else if (f->flags & FIELD_IS_SIGNED) 542 fprintf(ofp, "%%d"); 543 else 544 fprintf(ofp, "%%u"); 545 } 546 547 fprintf(ofp, "\\n\",\n\t "); 548 549 not_first = 0; 550 count = 0; 551 552 for (f = event->format.fields; f; f = f->next) { 553 if (not_first++) 554 fprintf(ofp, ", "); 555 556 if (++count % 5 == 0) 557 fprintf(ofp, "\n\t "); 558 559 if (f->flags & FIELD_IS_FLAG) { 560 if ((count - 1) % 5 != 0) { 561 fprintf(ofp, "\n\t "); 562 count = 4; 563 } 564 fprintf(ofp, "flag_str(\""); 565 fprintf(ofp, "%s::%s\", ", event->system, 566 event->name); 567 fprintf(ofp, "\"%s\", $%s)", f->name, 568 f->name); 569 } else if (f->flags & FIELD_IS_SYMBOLIC) { 570 if ((count - 1) % 5 != 0) { 571 fprintf(ofp, "\n\t "); 572 count = 4; 573 } 574 fprintf(ofp, "symbol_str(\""); 575 fprintf(ofp, "%s::%s\", ", event->system, 576 event->name); 577 fprintf(ofp, "\"%s\", $%s)", f->name, 578 f->name); 579 } else 580 fprintf(ofp, "$%s", f->name); 581 } 582 583 fprintf(ofp, ");\n"); 584 fprintf(ofp, "}\n\n"); 585 } 586 587 fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, " 588 "$common_cpu, $common_secs, $common_nsecs,\n\t " 589 "$common_pid, $common_comm) = @_;\n\n"); 590 591 fprintf(ofp, "\tprint_header($event_name, $common_cpu, " 592 "$common_secs, $common_nsecs,\n\t $common_pid, " 593 "$common_comm);\n}\n\n"); 594 595 fprintf(ofp, "sub print_header\n{\n" 596 "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n" 597 "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t " 598 "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}\n"); 599 600 fprintf(ofp, 601 "\n# Packed byte string args of process_event():\n" 602 "#\n" 603 "# $event:\tunion perf_event\tutil/event.h\n" 604 "# $attr:\tstruct perf_event_attr\tlinux/perf_event.h\n" 605 "# $sample:\tstruct perf_sample\tutil/event.h\n" 606 "# $raw_data:\tperf_sample->raw_data\tutil/event.h\n" 607 "\n" 608 "sub process_event\n" 609 "{\n" 610 "\tmy ($event, $attr, $sample, $raw_data) = @_;\n" 611 "\n" 612 "\tmy @event\t= unpack(\"LSS\", $event);\n" 613 "\tmy @attr\t= unpack(\"LLQQQQQLLQQ\", $attr);\n" 614 "\tmy @sample\t= unpack(\"QLLQQQQQLL\", $sample);\n" 615 "\tmy @raw_data\t= unpack(\"C*\", $raw_data);\n" 616 "\n" 617 "\tuse Data::Dumper;\n" 618 "\tprint Dumper \\@event, \\@attr, \\@sample, \\@raw_data;\n" 619 "}\n"); 620 621 fclose(ofp); 622 623 fprintf(stderr, "generated Perl script: %s\n", fname); 624 625 return 0; 626 } 627 628 struct scripting_ops perl_scripting_ops = { 629 .name = "Perl", 630 .start_script = perl_start_script, 631 .stop_script = perl_stop_script, 632 .process_event = perl_process_event, 633 .generate_script = perl_generate_script, 634 }; 635