aboutsummaryrefslogtreecommitdiffstats
path: root/tools/perf/util/trace-event-perl.c
diff options
context:
space:
mode:
authorTom Zanussi <tzanussi@gmail.com>2009-11-25 02:15:48 -0500
committerIngo Molnar <mingo@elte.hu>2009-11-28 04:04:26 -0500
commit16c632de64a74644a46e7636db26b2cfb530ca13 (patch)
tree4e7fdb4f84a1fba8b299c61a97bc76a8033e0565 /tools/perf/util/trace-event-perl.c
parenteb9a42caa7a926beb935a22bc59d981b35f0b652 (diff)
perf trace: Add Perl scripting support
Implement trace_scripting_ops to make Perl a supported perf trace scripting language. Additionally adds code that allows Perl trace scripts to access the 'flag' and 'symbolic' (__print_flags(), __print_symbolic()) field information parsed from the trace format files. Also adds the Perl implementation of the generate_script() trace_scripting_op, which creates a ready-to-run perf trace Perl script based on existing trace data. Scripts generated by this implementation print out all the fields for each event mentioned in perf.data (and will detect and generate the proper scripting code for 'flag' and 'symbolic' fields), and will additionally generate handlers for the special 'trace_unhandled', 'trace_begin' and 'trace_end' handlers. Script authors can simply remove the printing code to implement their own custom event handling. Signed-off-by: Tom Zanussi <tzanussi@gmail.com> Cc: fweisbec@gmail.com Cc: rostedt@goodmis.org Cc: anton@samba.org Cc: hch@infradead.org LKML-Reference: <1259133352-23685-4-git-send-email-tzanussi@gmail.com> Signed-off-by: Ingo Molnar <mingo@elte.hu>
Diffstat (limited to 'tools/perf/util/trace-event-perl.c')
-rw-r--r--tools/perf/util/trace-event-perl.c552
1 files changed, 552 insertions, 0 deletions
diff --git a/tools/perf/util/trace-event-perl.c b/tools/perf/util/trace-event-perl.c
new file mode 100644
index 000000000000..c56b08d704da
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.c
@@ -0,0 +1,552 @@
1/*
2 * trace-event-perl. Feed perf trace 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 "trace-event.h"
31#include "trace-event-perl.h"
32
33INTERP my_perl;
34
35#define FTRACE_MAX_EVENT \
36 ((1 << (sizeof(unsigned short) * 8)) - 1)
37
38struct event *events[FTRACE_MAX_EVENT];
39
40static struct scripting_context *scripting_context;
41
42static char *cur_field_name;
43static int zero_flag_atom;
44
45static void define_symbolic_value(const char *ev_name,
46 const char *field_name,
47 const char *field_value,
48 const char *field_str)
49{
50 unsigned long long value;
51 dSP;
52
53 value = eval_flag(field_value);
54
55 ENTER;
56 SAVETMPS;
57 PUSHMARK(SP);
58
59 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
60 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
61 XPUSHs(sv_2mortal(newSVuv(value)));
62 XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
63
64 PUTBACK;
65 if (get_cv("main::define_symbolic_value", 0))
66 call_pv("main::define_symbolic_value", G_SCALAR);
67 SPAGAIN;
68 PUTBACK;
69 FREETMPS;
70 LEAVE;
71}
72
73static void define_symbolic_values(struct print_flag_sym *field,
74 const char *ev_name,
75 const char *field_name)
76{
77 define_symbolic_value(ev_name, field_name, field->value, field->str);
78 if (field->next)
79 define_symbolic_values(field->next, ev_name, field_name);
80}
81
82static void define_symbolic_field(const char *ev_name,
83 const char *field_name)
84{
85 dSP;
86
87 ENTER;
88 SAVETMPS;
89 PUSHMARK(SP);
90
91 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
92 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
93
94 PUTBACK;
95 if (get_cv("main::define_symbolic_field", 0))
96 call_pv("main::define_symbolic_field", G_SCALAR);
97 SPAGAIN;
98 PUTBACK;
99 FREETMPS;
100 LEAVE;
101}
102
103static void define_flag_value(const char *ev_name,
104 const char *field_name,
105 const char *field_value,
106 const char *field_str)
107{
108 unsigned long long value;
109 dSP;
110
111 value = eval_flag(field_value);
112
113 ENTER;
114 SAVETMPS;
115 PUSHMARK(SP);
116
117 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
118 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
119 XPUSHs(sv_2mortal(newSVuv(value)));
120 XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
121
122 PUTBACK;
123 if (get_cv("main::define_flag_value", 0))
124 call_pv("main::define_flag_value", G_SCALAR);
125 SPAGAIN;
126 PUTBACK;
127 FREETMPS;
128 LEAVE;
129}
130
131static void define_flag_values(struct print_flag_sym *field,
132 const char *ev_name,
133 const char *field_name)
134{
135 define_flag_value(ev_name, field_name, field->value, field->str);
136 if (field->next)
137 define_flag_values(field->next, ev_name, field_name);
138}
139
140static void define_flag_field(const char *ev_name,
141 const char *field_name,
142 const char *delim)
143{
144 dSP;
145
146 ENTER;
147 SAVETMPS;
148 PUSHMARK(SP);
149
150 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
151 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
152 XPUSHs(sv_2mortal(newSVpv(delim, 0)));
153
154 PUTBACK;
155 if (get_cv("main::define_flag_field", 0))
156 call_pv("main::define_flag_field", G_SCALAR);
157 SPAGAIN;
158 PUTBACK;
159 FREETMPS;
160 LEAVE;
161}
162
163static void define_event_symbols(struct event *event,
164 const char *ev_name,
165 struct print_arg *args)
166{
167 switch (args->type) {
168 case PRINT_NULL:
169 break;
170 case PRINT_ATOM:
171 define_flag_value(ev_name, cur_field_name, "0",
172 args->atom.atom);
173 zero_flag_atom = 0;
174 break;
175 case PRINT_FIELD:
176 if (cur_field_name)
177 free(cur_field_name);
178 cur_field_name = strdup(args->field.name);
179 break;
180 case PRINT_FLAGS:
181 define_event_symbols(event, ev_name, args->flags.field);
182 define_flag_field(ev_name, cur_field_name, args->flags.delim);
183 define_flag_values(args->flags.flags, ev_name, cur_field_name);
184 break;
185 case PRINT_SYMBOL:
186 define_event_symbols(event, ev_name, args->symbol.field);
187 define_symbolic_field(ev_name, cur_field_name);
188 define_symbolic_values(args->symbol.symbols, ev_name,
189 cur_field_name);
190 break;
191 case PRINT_STRING:
192 break;
193 case PRINT_TYPE:
194 define_event_symbols(event, ev_name, args->typecast.item);
195 break;
196 case PRINT_OP:
197 if (strcmp(args->op.op, ":") == 0)
198 zero_flag_atom = 1;
199 define_event_symbols(event, ev_name, args->op.left);
200 define_event_symbols(event, ev_name, args->op.right);
201 break;
202 default:
203 /* we should warn... */
204 return;
205 }
206
207 if (args->next)
208 define_event_symbols(event, ev_name, args->next);
209}
210
211static inline struct event *find_cache_event(int type)
212{
213 static char ev_name[256];
214 struct event *event;
215
216 if (events[type])
217 return events[type];
218
219 events[type] = event = trace_find_event(type);
220 if (!event)
221 return NULL;
222
223 sprintf(ev_name, "%s::%s", event->system, event->name);
224
225 define_event_symbols(event, ev_name, event->print_fmt.args);
226
227 return event;
228}
229
230static void perl_process_event(int cpu, void *data,
231 int size __attribute((unused)),
232 unsigned long long nsecs, char *comm)
233{
234 struct format_field *field;
235 static char handler[256];
236 unsigned long long val;
237 unsigned long s, ns;
238 struct event *event;
239 int type;
240 int pid;
241
242 dSP;
243
244 type = trace_parse_common_type(data);
245
246 event = find_cache_event(type);
247 if (!event)
248 die("ug! no event found for type %d", type);
249
250 pid = trace_parse_common_pid(data);
251
252 sprintf(handler, "%s::%s", event->system, event->name);
253
254 s = nsecs / NSECS_PER_SEC;
255 ns = nsecs - s * NSECS_PER_SEC;
256
257 scripting_context->event_data = data;
258
259 ENTER;
260 SAVETMPS;
261 PUSHMARK(SP);
262
263 XPUSHs(sv_2mortal(newSVpv(handler, 0)));
264 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
265 XPUSHs(sv_2mortal(newSVuv(cpu)));
266 XPUSHs(sv_2mortal(newSVuv(s)));
267 XPUSHs(sv_2mortal(newSVuv(ns)));
268 XPUSHs(sv_2mortal(newSViv(pid)));
269 XPUSHs(sv_2mortal(newSVpv(comm, 0)));
270
271 /* common fields other than pid can be accessed via xsub fns */
272
273 for (field = event->format.fields; field; field = field->next) {
274 if (field->flags & FIELD_IS_STRING) {
275 int offset;
276 if (field->flags & FIELD_IS_DYNAMIC) {
277 offset = *(int *)(data + field->offset);
278 offset &= 0xffff;
279 } else
280 offset = field->offset;
281 XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
282 } else { /* FIELD_IS_NUMERIC */
283 val = read_size(data + field->offset, field->size);
284 if (field->flags & FIELD_IS_SIGNED) {
285 XPUSHs(sv_2mortal(newSViv(val)));
286 } else {
287 XPUSHs(sv_2mortal(newSVuv(val)));
288 }
289 }
290 }
291
292 PUTBACK;
293 if (get_cv(handler, 0))
294 call_pv(handler, G_SCALAR);
295 else if (get_cv("main::trace_unhandled", 0)) {
296 XPUSHs(sv_2mortal(newSVpv(handler, 0)));
297 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
298 XPUSHs(sv_2mortal(newSVuv(cpu)));
299 XPUSHs(sv_2mortal(newSVuv(nsecs)));
300 XPUSHs(sv_2mortal(newSViv(pid)));
301 XPUSHs(sv_2mortal(newSVpv(comm, 0)));
302 call_pv("main::trace_unhandled", G_SCALAR);
303 }
304 SPAGAIN;
305 PUTBACK;
306 FREETMPS;
307 LEAVE;
308}
309
310static void run_start_sub(void)
311{
312 dSP; /* access to Perl stack */
313 PUSHMARK(SP);
314
315 if (get_cv("main::trace_begin", 0))
316 call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
317}
318
319/*
320 * Start trace script
321 */
322static int perl_start_script(const char *script)
323{
324 const char *command_line[2] = { "", NULL };
325
326 command_line[1] = script;
327
328 my_perl = perl_alloc();
329 perl_construct(my_perl);
330
331 if (perl_parse(my_perl, NULL, 2, (char **)command_line, (char **)NULL))
332 return -1;
333
334 perl_run(my_perl);
335 if (SvTRUE(ERRSV))
336 return -1;
337
338 run_start_sub();
339
340 fprintf(stderr, "perf trace started with Perl script %s\n\n", script);
341
342 return 0;
343}
344
345/*
346 * Stop trace script
347 */
348static int perl_stop_script(void)
349{
350 dSP; /* access to Perl stack */
351 PUSHMARK(SP);
352
353 if (get_cv("main::trace_end", 0))
354 call_pv("main::trace_end", G_DISCARD | G_NOARGS);
355
356 perl_destruct(my_perl);
357 perl_free(my_perl);
358
359 fprintf(stderr, "\nperf trace Perl script stopped\n");
360
361 return 0;
362}
363
364static int perl_generate_script(const char *outfile)
365{
366 struct event *event = NULL;
367 struct format_field *f;
368 char fname[PATH_MAX];
369 int not_first, count;
370 FILE *ofp;
371
372 sprintf(fname, "%s.pl", outfile);
373 ofp = fopen(fname, "w");
374 if (ofp == NULL) {
375 fprintf(stderr, "couldn't open %s\n", fname);
376 return -1;
377 }
378
379 fprintf(ofp, "# perf trace event handlers, "
380 "generated by perf trace -g perl\n");
381
382 fprintf(ofp, "# Licensed under the terms of the GNU GPL"
383 " License version 2\n\n");
384
385 fprintf(ofp, "# The common_* event handler fields are the most useful "
386 "fields common to\n");
387
388 fprintf(ofp, "# all events. They don't necessarily correspond to "
389 "the 'common_*' fields\n");
390
391 fprintf(ofp, "# in the format files. Those fields not available as "
392 "handler params can\n");
393
394 fprintf(ofp, "# be retrieved using Perl functions of the form "
395 "common_*($context).\n");
396
397 fprintf(ofp, "# See Context.pm for the list of available "
398 "functions.\n\n");
399
400 fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
401 "Perf-Trace-Util/lib\";\n");
402
403 fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
404 fprintf(ofp, "use Perf::Trace::Core;\n");
405 fprintf(ofp, "use Perf::Trace::Context;\n");
406 fprintf(ofp, "use Perf::Trace::Util;\n\n");
407
408 fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
409 fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n");
410
411 while ((event = trace_find_next_event(event))) {
412 fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
413 fprintf(ofp, "\tmy (");
414
415 fprintf(ofp, "$event_name, ");
416 fprintf(ofp, "$context, ");
417 fprintf(ofp, "$common_cpu, ");
418 fprintf(ofp, "$common_secs, ");
419 fprintf(ofp, "$common_nsecs,\n");
420 fprintf(ofp, "\t $common_pid, ");
421 fprintf(ofp, "$common_comm,\n\t ");
422
423 not_first = 0;
424 count = 0;
425
426 for (f = event->format.fields; f; f = f->next) {
427 if (not_first++)
428 fprintf(ofp, ", ");
429 if (++count % 5 == 0)
430 fprintf(ofp, "\n\t ");
431
432 fprintf(ofp, "$%s", f->name);
433 }
434 fprintf(ofp, ") = @_;\n\n");
435
436 fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
437 "$common_secs, $common_nsecs,\n\t "
438 "$common_pid, $common_comm);\n\n");
439
440 fprintf(ofp, "\tprintf(\"");
441
442 not_first = 0;
443 count = 0;
444
445 for (f = event->format.fields; f; f = f->next) {
446 if (not_first++)
447 fprintf(ofp, ", ");
448 if (count && count % 4 == 0) {
449 fprintf(ofp, "\".\n\t \"");
450 }
451 count++;
452
453 fprintf(ofp, "%s=", f->name);
454 if (f->flags & FIELD_IS_STRING ||
455 f->flags & FIELD_IS_FLAG ||
456 f->flags & FIELD_IS_SYMBOLIC)
457 fprintf(ofp, "%%s");
458 else if (f->flags & FIELD_IS_SIGNED)
459 fprintf(ofp, "%%d");
460 else
461 fprintf(ofp, "%%u");
462 }
463
464 fprintf(ofp, "\\n\",\n\t ");
465
466 not_first = 0;
467 count = 0;
468
469 for (f = event->format.fields; f; f = f->next) {
470 if (not_first++)
471 fprintf(ofp, ", ");
472
473 if (++count % 5 == 0)
474 fprintf(ofp, "\n\t ");
475
476 if (f->flags & FIELD_IS_FLAG) {
477 if ((count - 1) % 5 != 0) {
478 fprintf(ofp, "\n\t ");
479 count = 4;
480 }
481 fprintf(ofp, "flag_str(\"");
482 fprintf(ofp, "%s::%s\", ", event->system,
483 event->name);
484 fprintf(ofp, "\"%s\", $%s)", f->name,
485 f->name);
486 } else if (f->flags & FIELD_IS_SYMBOLIC) {
487 if ((count - 1) % 5 != 0) {
488 fprintf(ofp, "\n\t ");
489 count = 4;
490 }
491 fprintf(ofp, "symbol_str(\"");
492 fprintf(ofp, "%s::%s\", ", event->system,
493 event->name);
494 fprintf(ofp, "\"%s\", $%s)", f->name,
495 f->name);
496 } else
497 fprintf(ofp, "$%s", f->name);
498 }
499
500 fprintf(ofp, ");\n");
501 fprintf(ofp, "}\n\n");
502 }
503
504 fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
505 "$common_cpu, $common_secs, $common_nsecs,\n\t "
506 "$common_pid, $common_comm) = @_;\n\n");
507
508 fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
509 "$common_secs, $common_nsecs,\n\t $common_pid, "
510 "$common_comm);\n}\n\n");
511
512 fprintf(ofp, "sub print_header\n{\n"
513 "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
514 "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t "
515 "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}");
516
517 fclose(ofp);
518
519 fprintf(stderr, "generated Perl script: %s\n", fname);
520
521 return 0;
522}
523
524struct scripting_ops perl_scripting_ops = {
525 .name = "Perl",
526 .start_script = perl_start_script,
527 .stop_script = perl_stop_script,
528 .process_event = perl_process_event,
529 .generate_script = perl_generate_script,
530};
531
532#ifdef NO_LIBPERL
533void setup_perl_scripting(void)
534{
535 fprintf(stderr, "Perl scripting not supported."
536 " Install libperl-dev[el] and rebuild perf to get it.\n");
537}
538#else
539void setup_perl_scripting(void)
540{
541 int err;
542 err = script_spec_register("Perl", &perl_scripting_ops);
543 if (err)
544 die("error registering Perl script extension");
545
546 err = script_spec_register("pl", &perl_scripting_ops);
547 if (err)
548 die("error registering pl script extension");
549
550 scripting_context = malloc(sizeof(struct scripting_context));
551}
552#endif
generated by cgit v1.2.2 (git 2.25.0) at 2024-10-16 18:38:31 -0400