aboutsummaryrefslogtreecommitdiffstats
path: root/tools/perf
diff options
context:
space:
mode:
Diffstat (limited to 'tools/perf')
-rw-r--r--tools/perf/Makefile13
-rw-r--r--tools/perf/builtin-trace.c2
-rw-r--r--tools/perf/util/trace-event-parse.c18
-rw-r--r--tools/perf/util/trace-event-perl.c552
-rw-r--r--tools/perf/util/trace-event-perl.h42
-rw-r--r--tools/perf/util/trace-event.h7
6 files changed, 629 insertions, 5 deletions
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index f1537a94a05f..19e37cd14ae4 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -407,6 +407,7 @@ LIB_OBJS += util/thread.o
407LIB_OBJS += util/trace-event-parse.o 407LIB_OBJS += util/trace-event-parse.o
408LIB_OBJS += util/trace-event-read.o 408LIB_OBJS += util/trace-event-read.o
409LIB_OBJS += util/trace-event-info.o 409LIB_OBJS += util/trace-event-info.o
410LIB_OBJS += util/trace-event-perl.o
410LIB_OBJS += util/svghelper.o 411LIB_OBJS += util/svghelper.o
411LIB_OBJS += util/sort.o 412LIB_OBJS += util/sort.o
412LIB_OBJS += util/hist.o 413LIB_OBJS += util/hist.o
@@ -489,6 +490,15 @@ else
489 LIB_OBJS += util/probe-finder.o 490 LIB_OBJS += util/probe-finder.o
490endif 491endif
491 492
493PERL_EMBED_LDOPTS = `perl -MExtUtils::Embed -e ldopts`
494PERL_EMBED_CCOPTS = `perl -MExtUtils::Embed -e ccopts`
495
496ifneq ($(shell sh -c "(echo '\#include <EXTERN.h>'; echo '\#include <perl.h>'; echo 'int main(void) { perl_alloc(); return 0; }') | $(CC) -x c - $(PERL_EMBED_CCOPTS) -o /dev/null $(PERL_EMBED_LDOPTS) > /dev/null 2>&1 && echo y"), y)
497 BASIC_CFLAGS += -DNO_LIBPERL
498else
499 ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
500endif
501
492ifdef NO_DEMANGLE 502ifdef NO_DEMANGLE
493 BASIC_CFLAGS += -DNO_DEMANGLE 503 BASIC_CFLAGS += -DNO_DEMANGLE
494else 504else
@@ -860,6 +870,9 @@ util/hweight.o: ../../lib/hweight.c PERF-CFLAGS
860util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS 870util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
861 $(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $< 871 $(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $<
862 872
873util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
874 $(QUIET_CC)$(CC) -o util/trace-event-perl.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter $<
875
863perf-%$X: %.o $(PERFLIBS) 876perf-%$X: %.o $(PERFLIBS)
864 $(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS) 877 $(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
865 878
diff --git a/tools/perf/builtin-trace.c b/tools/perf/builtin-trace.c
index e96bb534b948..ca8ebf1ec64e 100644
--- a/tools/perf/builtin-trace.c
+++ b/tools/perf/builtin-trace.c
@@ -38,6 +38,8 @@ static void setup_scripting(void)
38 /* make sure PERF_EXEC_PATH is set for scripts */ 38 /* make sure PERF_EXEC_PATH is set for scripts */
39 perf_set_argv_exec_path(perf_exec_path()); 39 perf_set_argv_exec_path(perf_exec_path());
40 40
41 setup_perl_scripting();
42
41 scripting_ops = &default_scripting_ops; 43 scripting_ops = &default_scripting_ops;
42} 44}
43 45
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index 85d7163a9fd4..1f16495e5597 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -1888,7 +1888,7 @@ find_any_field(struct event *event, const char *name)
1888 return find_field(event, name); 1888 return find_field(event, name);
1889} 1889}
1890 1890
1891static unsigned long long read_size(void *ptr, int size) 1891unsigned long long read_size(void *ptr, int size)
1892{ 1892{
1893 switch (size) { 1893 switch (size) {
1894 case 1: 1894 case 1:
@@ -1973,7 +1973,7 @@ int trace_parse_common_type(void *data)
1973 "common_type"); 1973 "common_type");
1974} 1974}
1975 1975
1976static int parse_common_pid(void *data) 1976int trace_parse_common_pid(void *data)
1977{ 1977{
1978 static int pid_offset; 1978 static int pid_offset;
1979 static int pid_size; 1979 static int pid_size;
@@ -2025,6 +2025,14 @@ struct event *trace_find_event(int id)
2025 return event; 2025 return event;
2026} 2026}
2027 2027
2028struct event *trace_find_next_event(struct event *event)
2029{
2030 if (!event)
2031 return event_list;
2032
2033 return event->next;
2034}
2035
2028static unsigned long long eval_num_arg(void *data, int size, 2036static unsigned long long eval_num_arg(void *data, int size,
2029 struct event *event, struct print_arg *arg) 2037 struct event *event, struct print_arg *arg)
2030{ 2038{
@@ -2164,7 +2172,7 @@ static const struct flag flags[] = {
2164 { "HRTIMER_RESTART", 1 }, 2172 { "HRTIMER_RESTART", 1 },
2165}; 2173};
2166 2174
2167static unsigned long long eval_flag(const char *flag) 2175unsigned long long eval_flag(const char *flag)
2168{ 2176{
2169 int i; 2177 int i;
2170 2178
@@ -2694,7 +2702,7 @@ get_return_for_leaf(int cpu, int cur_pid, unsigned long long cur_func,
2694 if (!(event->flags & EVENT_FL_ISFUNCRET)) 2702 if (!(event->flags & EVENT_FL_ISFUNCRET))
2695 return NULL; 2703 return NULL;
2696 2704
2697 pid = parse_common_pid(next->data); 2705 pid = trace_parse_common_pid(next->data);
2698 field = find_field(event, "func"); 2706 field = find_field(event, "func");
2699 if (!field) 2707 if (!field)
2700 die("function return does not have field func"); 2708 die("function return does not have field func");
@@ -2980,7 +2988,7 @@ void print_event(int cpu, void *data, int size, unsigned long long nsecs,
2980 return; 2988 return;
2981 } 2989 }
2982 2990
2983 pid = parse_common_pid(data); 2991 pid = trace_parse_common_pid(data);
2984 2992
2985 if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET)) 2993 if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET))
2986 return pretty_print_func_graph(data, size, event, cpu, 2994 return pretty_print_func_graph(data, size, event, cpu,
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
diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h
new file mode 100644
index 000000000000..6c94fa93013d
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.h
@@ -0,0 +1,42 @@
1#ifndef __PERF_TRACE_EVENT_PERL_H
2#define __PERF_TRACE_EVENT_PERL_H
3#ifdef NO_LIBPERL
4typedef int INTERP;
5#define dSP
6#define ENTER
7#define SAVETMPS
8#define PUTBACK
9#define SPAGAIN
10#define FREETMPS
11#define LEAVE
12#define SP
13#define ERRSV
14#define G_SCALAR (0)
15#define G_DISCARD (0)
16#define G_NOARGS (0)
17#define PUSHMARK(a)
18#define SvTRUE(a) (0)
19#define XPUSHs(s)
20#define sv_2mortal(a)
21#define newSVpv(a,b)
22#define newSVuv(a)
23#define newSViv(a)
24#define get_cv(a,b) (0)
25#define call_pv(a,b) (0)
26#define perl_alloc() (0)
27#define perl_construct(a) (0)
28#define perl_parse(a,b,c,d,e) (0)
29#define perl_run(a) (0)
30#define perl_destruct(a) (0)
31#define perl_free(a) (0)
32#else
33#include <EXTERN.h>
34#include <perl.h>
35typedef PerlInterpreter * INTERP;
36#endif
37
38struct scripting_context {
39 void *event_data;
40};
41
42#endif /* __PERF_TRACE_EVENT_PERL_H */
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index aeb915778ae7..b1e58d3d947d 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -245,10 +245,14 @@ extern int latency_format;
245 245
246int parse_header_page(char *buf, unsigned long size); 246int parse_header_page(char *buf, unsigned long size);
247int trace_parse_common_type(void *data); 247int trace_parse_common_type(void *data);
248int trace_parse_common_pid(void *data);
248struct event *trace_find_event(int id); 249struct event *trace_find_event(int id);
250struct event *trace_find_next_event(struct event *event);
251unsigned long long read_size(void *ptr, int size);
249unsigned long long 252unsigned long long
250raw_field_value(struct event *event, const char *name, void *data); 253raw_field_value(struct event *event, const char *name, void *data);
251void *raw_field_ptr(struct event *event, const char *name, void *data); 254void *raw_field_ptr(struct event *event, const char *name, void *data);
255unsigned long long eval_flag(const char *flag);
252 256
253int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events); 257int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events);
254 258
@@ -272,4 +276,7 @@ struct scripting_ops {
272 276
273int script_spec_register(const char *spec, struct scripting_ops *ops); 277int script_spec_register(const char *spec, struct scripting_ops *ops);
274 278
279extern struct scripting_ops perl_scripting_ops;
280void setup_perl_scripting(void);
281
275#endif /* __PERF_TRACE_EVENTS_H */ 282#endif /* __PERF_TRACE_EVENTS_H */