diff options
-rw-r--r-- | tools/perf/util/scripting-engines/trace-event-perl.c | 73 |
1 files changed, 67 insertions, 6 deletions
diff --git a/tools/perf/util/scripting-engines/trace-event-perl.c b/tools/perf/util/scripting-engines/trace-event-perl.c index a82ce4303ff5..e30749e38a9b 100644 --- a/tools/perf/util/scripting-engines/trace-event-perl.c +++ b/tools/perf/util/scripting-engines/trace-event-perl.c | |||
@@ -30,6 +30,7 @@ | |||
30 | #include "../thread.h" | 30 | #include "../thread.h" |
31 | #include "../event.h" | 31 | #include "../event.h" |
32 | #include "../trace-event.h" | 32 | #include "../trace-event.h" |
33 | #include "../evsel.h" | ||
33 | 34 | ||
34 | #include <EXTERN.h> | 35 | #include <EXTERN.h> |
35 | #include <perl.h> | 36 | #include <perl.h> |
@@ -247,11 +248,11 @@ static inline struct event *find_cache_event(int type) | |||
247 | return event; | 248 | return event; |
248 | } | 249 | } |
249 | 250 | ||
250 | static void perl_process_event(union perf_event *pevent __unused, | 251 | static void perl_process_tracepoint(union perf_event *pevent __unused, |
251 | struct perf_sample *sample, | 252 | struct perf_sample *sample, |
252 | struct perf_evsel *evsel, | 253 | struct perf_evsel *evsel, |
253 | struct machine *machine __unused, | 254 | struct machine *machine __unused, |
254 | struct thread *thread) | 255 | struct thread *thread) |
255 | { | 256 | { |
256 | struct format_field *field; | 257 | struct format_field *field; |
257 | static char handler[256]; | 258 | static char handler[256]; |
@@ -267,6 +268,9 @@ static void perl_process_event(union perf_event *pevent __unused, | |||
267 | 268 | ||
268 | dSP; | 269 | dSP; |
269 | 270 | ||
271 | if (evsel->attr.type != PERF_TYPE_TRACEPOINT) | ||
272 | return; | ||
273 | |||
270 | type = trace_parse_common_type(data); | 274 | type = trace_parse_common_type(data); |
271 | 275 | ||
272 | event = find_cache_event(type); | 276 | event = find_cache_event(type); |
@@ -334,6 +338,42 @@ static void perl_process_event(union perf_event *pevent __unused, | |||
334 | LEAVE; | 338 | LEAVE; |
335 | } | 339 | } |
336 | 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 | |||
337 | static void run_start_sub(void) | 377 | static void run_start_sub(void) |
338 | { | 378 | { |
339 | dSP; /* access to Perl stack */ | 379 | dSP; /* access to Perl stack */ |
@@ -555,7 +595,28 @@ static int perl_generate_script(const char *outfile) | |||
555 | fprintf(ofp, "sub print_header\n{\n" | 595 | fprintf(ofp, "sub print_header\n{\n" |
556 | "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n" | 596 | "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n" |
557 | "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t " | 597 | "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t " |
558 | "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}"); | 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"); | ||
559 | 620 | ||
560 | fclose(ofp); | 621 | fclose(ofp); |
561 | 622 | ||