aboutsummaryrefslogtreecommitdiffstats
path: root/tools
diff options
context:
space:
mode:
authorIngo Molnar <mingo@elte.hu>2009-12-03 14:10:35 -0500
committerIngo Molnar <mingo@elte.hu>2009-12-03 14:10:42 -0500
commit23ba90e328fd2326378447cafafa47defdfc83c2 (patch)
treec1febaf468e0255eedfbedf07a07d8178a0b5ac9 /tools
parente859cf8656043f158b4004ccc8cbbf1ba4f97177 (diff)
parent8ea339adc0a48236008e59dd21564d71c37b331c (diff)
Merge branch 'perf/scripting' into perf/core
Merge reason: it's ready for v2.6.33. Signed-off-by: Ingo Molnar <mingo@elte.hu>
Diffstat (limited to 'tools')
-rw-r--r--tools/perf/Documentation/perf-trace-perl.txt219
-rw-r--r--tools/perf/Documentation/perf-trace.txt11
-rw-r--r--tools/perf/Makefile26
-rw-r--r--tools/perf/builtin-trace.c259
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/Context.c134
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/Context.xs41
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL17
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/README59
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm55
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm192
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm88
-rw-r--r--tools/perf/scripts/perl/Perf-Trace-Util/typemap1
-rw-r--r--tools/perf/scripts/perl/bin/check-perf-trace-record7
-rw-r--r--tools/perf/scripts/perl/bin/check-perf-trace-report5
-rw-r--r--tools/perf/scripts/perl/bin/rw-by-file-record2
-rw-r--r--tools/perf/scripts/perl/bin/rw-by-file-report5
-rw-r--r--tools/perf/scripts/perl/bin/rw-by-pid-record2
-rw-r--r--tools/perf/scripts/perl/bin/rw-by-pid-report5
-rw-r--r--tools/perf/scripts/perl/bin/wakeup-latency-record6
-rw-r--r--tools/perf/scripts/perl/bin/wakeup-latency-report5
-rw-r--r--tools/perf/scripts/perl/bin/workqueue-stats-record2
-rw-r--r--tools/perf/scripts/perl/bin/workqueue-stats-report6
-rw-r--r--tools/perf/scripts/perl/check-perf-trace.pl106
-rw-r--r--tools/perf/scripts/perl/rw-by-file.pl105
-rw-r--r--tools/perf/scripts/perl/rw-by-pid.pl170
-rw-r--r--tools/perf/scripts/perl/wakeup-latency.pl103
-rw-r--r--tools/perf/scripts/perl/workqueue-stats.pl129
-rw-r--r--tools/perf/util/trace-event-parse.c41
-rw-r--r--tools/perf/util/trace-event-perl.c598
-rw-r--r--tools/perf/util/trace-event-perl.h51
-rw-r--r--tools/perf/util/trace-event.h23
31 files changed, 2458 insertions, 15 deletions
diff --git a/tools/perf/Documentation/perf-trace-perl.txt b/tools/perf/Documentation/perf-trace-perl.txt
new file mode 100644
index 00000000000..c5f55f43909
--- /dev/null
+++ b/tools/perf/Documentation/perf-trace-perl.txt
@@ -0,0 +1,219 @@
1perf-trace-perl(1)
2==================
3
4NAME
5----
6perf-trace-perl - Process trace data with a Perl script
7
8SYNOPSIS
9--------
10[verse]
11'perf trace' [-s [lang]:script[.ext] ]
12
13DESCRIPTION
14-----------
15
16This perf trace option is used to process perf trace data using perf's
17built-in Perl interpreter. It reads and processes the input file and
18displays the results of the trace analysis implemented in the given
19Perl script, if any.
20
21STARTER SCRIPTS
22---------------
23
24You can avoid reading the rest of this document by running 'perf trace
25-g perl' in the same directory as an existing perf.data trace file.
26That will generate a starter script containing a handler for each of
27the event types in the trace file; it simply prints every available
28field for each event in the trace file.
29
30You can also look at the existing scripts in
31~/libexec/perf-core/scripts/perl for typical examples showing how to
32do basic things like aggregate event data, print results, etc. Also,
33the check-perf-trace.pl script, while not interesting for its results,
34attempts to exercise all of the main scripting features.
35
36EVENT HANDLERS
37--------------
38
39When perf trace is invoked using a trace script, a user-defined
40'handler function' is called for each event in the trace. If there's
41no handler function defined for a given event type, the event is
42ignored (or passed to a 'trace_handled' function, see below) and the
43next event is processed.
44
45Most of the event's field values are passed as arguments to the
46handler function; some of the less common ones aren't - those are
47available as calls back into the perf executable (see below).
48
49As an example, the following perf record command can be used to record
50all sched_wakeup events in the system:
51
52 # perf record -c 1 -f -a -M -R -e sched:sched_wakeup
53
54Traces meant to be processed using a script should be recorded with
55the above options: -c 1 says to sample every event, -a to enable
56system-wide collection, -M to multiplex the output, and -R to collect
57raw samples.
58
59The format file for the sched_wakep event defines the following fields
60(see /sys/kernel/debug/tracing/events/sched/sched_wakeup/format):
61
62----
63 format:
64 field:unsigned short common_type;
65 field:unsigned char common_flags;
66 field:unsigned char common_preempt_count;
67 field:int common_pid;
68 field:int common_lock_depth;
69
70 field:char comm[TASK_COMM_LEN];
71 field:pid_t pid;
72 field:int prio;
73 field:int success;
74 field:int target_cpu;
75----
76
77The handler function for this event would be defined as:
78
79----
80sub sched::sched_wakeup
81{
82 my ($event_name, $context, $common_cpu, $common_secs,
83 $common_nsecs, $common_pid, $common_comm,
84 $comm, $pid, $prio, $success, $target_cpu) = @_;
85}
86----
87
88The handler function takes the form subsystem::event_name.
89
90The $common_* arguments in the handler's argument list are the set of
91arguments passed to all event handlers; some of the fields correspond
92to the common_* fields in the format file, but some are synthesized,
93and some of the common_* fields aren't common enough to to be passed
94to every event as arguments but are available as library functions.
95
96Here's a brief description of each of the invariant event args:
97
98 $event_name the name of the event as text
99 $context an opaque 'cookie' used in calls back into perf
100 $common_cpu the cpu the event occurred on
101 $common_secs the secs portion of the event timestamp
102 $common_nsecs the nsecs portion of the event timestamp
103 $common_pid the pid of the current task
104 $common_comm the name of the current process
105
106All of the remaining fields in the event's format file have
107counterparts as handler function arguments of the same name, as can be
108seen in the example above.
109
110The above provides the basics needed to directly access every field of
111every event in a trace, which covers 90% of what you need to know to
112write a useful trace script. The sections below cover the rest.
113
114SCRIPT LAYOUT
115-------------
116
117Every perf trace Perl script should start by setting up a Perl module
118search path and 'use'ing a few support modules (see module
119descriptions below):
120
121----
122 use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
123 use lib "./Perf-Trace-Util/lib";
124 use Perf::Trace::Core;
125 use Perf::Trace::Context;
126 use Perf::Trace::Util;
127----
128
129The rest of the script can contain handler functions and support
130functions in any order.
131
132Aside from the event handler functions discussed above, every script
133can implement a set of optional functions:
134
135*trace_begin*, if defined, is called before any event is processed and
136gives scripts a chance to do setup tasks:
137
138----
139 sub trace_begin
140 {
141 }
142----
143
144*trace_end*, if defined, is called after all events have been
145 processed and gives scripts a chance to do end-of-script tasks, such
146 as display results:
147
148----
149sub trace_end
150{
151}
152----
153
154*trace_unhandled*, if defined, is called after for any event that
155 doesn't have a handler explicitly defined for it. The standard set
156 of common arguments are passed into it:
157
158----
159sub trace_unhandled
160{
161 my ($event_name, $context, $common_cpu, $common_secs,
162 $common_nsecs, $common_pid, $common_comm) = @_;
163}
164----
165
166The remaining sections provide descriptions of each of the available
167built-in perf trace Perl modules and their associated functions.
168
169AVAILABLE MODULES AND FUNCTIONS
170-------------------------------
171
172The following sections describe the functions and variables available
173via the various Perf::Trace::* Perl modules. To use the functions and
174variables from the given module, add the corresponding 'use
175Perf::Trace::XXX' line to your perf trace script.
176
177Perf::Trace::Core Module
178~~~~~~~~~~~~~~~~~~~~~~~~
179
180These functions provide some essential functions to user scripts.
181
182The *flag_str* and *symbol_str* functions provide human-readable
183strings for flag and symbolic fields. These correspond to the strings
184and values parsed from the 'print fmt' fields of the event format
185files:
186
187 flag_str($event_name, $field_name, $field_value) - returns the string represention corresponding to $field_value for the flag field $field_name of event $event_name
188 symbol_str($event_name, $field_name, $field_value) - returns the string represention corresponding to $field_value for the symbolic field $field_name of event $event_name
189
190Perf::Trace::Context Module
191~~~~~~~~~~~~~~~~~~~~~~~~~~~
192
193Some of the 'common' fields in the event format file aren't all that
194common, but need to be made accessible to user scripts nonetheless.
195
196Perf::Trace::Context defines a set of functions that can be used to
197access this data in the context of the current event. Each of these
198functions expects a $context variable, which is the same as the
199$context variable passed into every event handler as the second
200argument.
201
202 common_pc($context) - returns common_preempt count for the current event
203 common_flags($context) - returns common_flags for the current event
204 common_lock_depth($context) - returns common_lock_depth for the current event
205
206Perf::Trace::Util Module
207~~~~~~~~~~~~~~~~~~~~~~~~
208
209Various utility functions for use with perf trace:
210
211 nsecs($secs, $nsecs) - returns total nsecs given secs/nsecs pair
212 nsecs_secs($nsecs) - returns whole secs portion given nsecs
213 nsecs_nsecs($nsecs) - returns nsecs remainder given nsecs
214 nsecs_str($nsecs) - returns printable string in the form secs.nsecs
215 avg($total, $n) - returns average given a sum and a total number of values
216
217SEE ALSO
218--------
219linkperf:perf-trace[1]
diff --git a/tools/perf/Documentation/perf-trace.txt b/tools/perf/Documentation/perf-trace.txt
index 41ed75398ca..07065efa60e 100644
--- a/tools/perf/Documentation/perf-trace.txt
+++ b/tools/perf/Documentation/perf-trace.txt
@@ -20,6 +20,15 @@ OPTIONS
20--dump-raw-trace=:: 20--dump-raw-trace=::
21 Display verbose dump of the trace data. 21 Display verbose dump of the trace data.
22 22
23-s::
24--script=::
25 Process trace data with the given script ([lang]:script[.ext]).
26
27-g::
28--gen-script=::
29 Generate perf-trace.[ext] starter script for given language,
30 using current perf.data.
31
23SEE ALSO 32SEE ALSO
24-------- 33--------
25linkperf:perf-record[1] 34linkperf:perf-record[1], linkperf:perf-trace-perl[1]
diff --git a/tools/perf/Makefile b/tools/perf/Makefile
index f8537cf812c..23ec66098bd 100644
--- a/tools/perf/Makefile
+++ b/tools/perf/Makefile
@@ -409,6 +409,7 @@ LIB_OBJS += util/thread.o
409LIB_OBJS += util/trace-event-parse.o 409LIB_OBJS += util/trace-event-parse.o
410LIB_OBJS += util/trace-event-read.o 410LIB_OBJS += util/trace-event-read.o
411LIB_OBJS += util/trace-event-info.o 411LIB_OBJS += util/trace-event-info.o
412LIB_OBJS += util/trace-event-perl.o
412LIB_OBJS += util/svghelper.o 413LIB_OBJS += util/svghelper.o
413LIB_OBJS += util/sort.o 414LIB_OBJS += util/sort.o
414LIB_OBJS += util/hist.o 415LIB_OBJS += util/hist.o
@@ -491,6 +492,16 @@ else
491 LIB_OBJS += util/probe-finder.o 492 LIB_OBJS += util/probe-finder.o
492endif 493endif
493 494
495PERL_EMBED_LDOPTS = `perl -MExtUtils::Embed -e ldopts 2>/dev/null`
496PERL_EMBED_CCOPTS = `perl -MExtUtils::Embed -e ccopts 2>/dev/null`
497
498ifneq ($(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)
499 BASIC_CFLAGS += -DNO_LIBPERL
500else
501 ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
502 LIB_OBJS += scripts/perl/Perf-Trace-Util/Context.o
503endif
504
494ifdef NO_DEMANGLE 505ifdef NO_DEMANGLE
495 BASIC_CFLAGS += -DNO_DEMANGLE 506 BASIC_CFLAGS += -DNO_DEMANGLE
496else 507else
@@ -862,6 +873,12 @@ util/hweight.o: ../../lib/hweight.c PERF-CFLAGS
862util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS 873util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
863 $(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $< 874 $(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $<
864 875
876util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
877 $(QUIET_CC)$(CC) -o util/trace-event-perl.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter -Wno-shadow $<
878
879scripts/perl/Perf-Trace-Util/Context.o: scripts/perl/Perf-Trace-Util/Context.c PERF-CFLAGS
880 $(QUIET_CC)$(CC) -o scripts/perl/Perf-Trace-Util/Context.o -c $(ALL_CFLAGS) $(PERL_EMBED_CCOPTS) -Wno-redundant-decls -Wno-strict-prototypes -Wno-unused-parameter -Wno-nested-externs $<
881
865perf-%$X: %.o $(PERFLIBS) 882perf-%$X: %.o $(PERFLIBS)
866 $(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS) 883 $(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
867 884
@@ -969,6 +986,13 @@ export perfexec_instdir
969install: all 986install: all
970 $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)' 987 $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'
971 $(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)' 988 $(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)'
989 $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
990 $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
991 $(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
992 $(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl'
993 $(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
994 $(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
995 $(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
972ifdef BUILT_INS 996ifdef BUILT_INS
973 $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' 997 $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
974 $(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' 998 $(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
@@ -1054,7 +1078,7 @@ distclean: clean
1054# $(RM) configure 1078# $(RM) configure
1055 1079
1056clean: 1080clean:
1057 $(RM) *.o */*.o $(LIB_FILE) 1081 $(RM) *.o */*.o */*/*.o */*/*/*.o $(LIB_FILE)
1058 $(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X 1082 $(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X
1059 $(RM) $(TEST_PROGRAMS) 1083 $(RM) $(TEST_PROGRAMS)
1060 $(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope* 1084 $(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope*
diff --git a/tools/perf/builtin-trace.c b/tools/perf/builtin-trace.c
index a7750256c40..abb914aa7be 100644
--- a/tools/perf/builtin-trace.c
+++ b/tools/perf/builtin-trace.c
@@ -5,6 +5,50 @@
5#include "util/symbol.h" 5#include "util/symbol.h"
6#include "util/thread.h" 6#include "util/thread.h"
7#include "util/header.h" 7#include "util/header.h"
8#include "util/exec_cmd.h"
9#include "util/trace-event.h"
10
11static char const *script_name;
12static char const *generate_script_lang;
13
14static int default_start_script(const char *script __attribute((unused)))
15{
16 return 0;
17}
18
19static int default_stop_script(void)
20{
21 return 0;
22}
23
24static int default_generate_script(const char *outfile __attribute ((unused)))
25{
26 return 0;
27}
28
29static struct scripting_ops default_scripting_ops = {
30 .start_script = default_start_script,
31 .stop_script = default_stop_script,
32 .process_event = print_event,
33 .generate_script = default_generate_script,
34};
35
36static struct scripting_ops *scripting_ops;
37
38static void setup_scripting(void)
39{
40 /* make sure PERF_EXEC_PATH is set for scripts */
41 perf_set_argv_exec_path(perf_exec_path());
42
43 setup_perl_scripting();
44
45 scripting_ops = &default_scripting_ops;
46}
47
48static int cleanup_scripting(void)
49{
50 return scripting_ops->stop_script();
51}
8 52
9#include "util/parse-options.h" 53#include "util/parse-options.h"
10 54
@@ -13,11 +57,12 @@
13 57
14#include "util/trace-event.h" 58#include "util/trace-event.h"
15#include "util/data_map.h" 59#include "util/data_map.h"
60#include "util/exec_cmd.h"
16 61
17static char const *input_name = "perf.data"; 62static char const *input_name = "perf.data";
18 63
19static struct perf_header *header; 64static struct perf_header *header;
20static u64 sample_type; 65static u64 sample_type;
21 66
22static int process_sample_event(event_t *event) 67static int process_sample_event(event_t *event)
23{ 68{
@@ -69,7 +114,8 @@ static int process_sample_event(event_t *event)
69 * field, although it should be the same than this perf 114 * field, although it should be the same than this perf
70 * event pid 115 * event pid
71 */ 116 */
72 print_event(cpu, raw->data, raw->size, timestamp, thread->comm); 117 scripting_ops->process_event(cpu, raw->data, raw->size,
118 timestamp, thread->comm);
73 } 119 }
74 event__stats.total += period; 120 event__stats.total += period;
75 121
@@ -105,6 +151,154 @@ static int __cmd_trace(void)
105 0, 0, &event__cwdlen, &event__cwd); 151 0, 0, &event__cwdlen, &event__cwd);
106} 152}
107 153
154struct script_spec {
155 struct list_head node;
156 struct scripting_ops *ops;
157 char spec[0];
158};
159
160LIST_HEAD(script_specs);
161
162static struct script_spec *script_spec__new(const char *spec,
163 struct scripting_ops *ops)
164{
165 struct script_spec *s = malloc(sizeof(*s) + strlen(spec) + 1);
166
167 if (s != NULL) {
168 strcpy(s->spec, spec);
169 s->ops = ops;
170 }
171
172 return s;
173}
174
175static void script_spec__delete(struct script_spec *s)
176{
177 free(s->spec);
178 free(s);
179}
180
181static void script_spec__add(struct script_spec *s)
182{
183 list_add_tail(&s->node, &script_specs);
184}
185
186static struct script_spec *script_spec__find(const char *spec)
187{
188 struct script_spec *s;
189
190 list_for_each_entry(s, &script_specs, node)
191 if (strcasecmp(s->spec, spec) == 0)
192 return s;
193 return NULL;
194}
195
196static struct script_spec *script_spec__findnew(const char *spec,
197 struct scripting_ops *ops)
198{
199 struct script_spec *s = script_spec__find(spec);
200
201 if (s)
202 return s;
203
204 s = script_spec__new(spec, ops);
205 if (!s)
206 goto out_delete_spec;
207
208 script_spec__add(s);
209
210 return s;
211
212out_delete_spec:
213 script_spec__delete(s);
214
215 return NULL;
216}
217
218int script_spec_register(const char *spec, struct scripting_ops *ops)
219{
220 struct script_spec *s;
221
222 s = script_spec__find(spec);
223 if (s)
224 return -1;
225
226 s = script_spec__findnew(spec, ops);
227 if (!s)
228 return -1;
229
230 return 0;
231}
232
233static struct scripting_ops *script_spec__lookup(const char *spec)
234{
235 struct script_spec *s = script_spec__find(spec);
236 if (!s)
237 return NULL;
238
239 return s->ops;
240}
241
242static void list_available_languages(void)
243{
244 struct script_spec *s;
245
246 fprintf(stderr, "\n");
247 fprintf(stderr, "Scripting language extensions (used in "
248 "perf trace -s [spec:]script.[spec]):\n\n");
249
250 list_for_each_entry(s, &script_specs, node)
251 fprintf(stderr, " %-42s [%s]\n", s->spec, s->ops->name);
252
253 fprintf(stderr, "\n");
254}
255
256static int parse_scriptname(const struct option *opt __used,
257 const char *str, int unset __used)
258{
259 char spec[PATH_MAX];
260 const char *script, *ext;
261 int len;
262
263 if (strcmp(str, "list") == 0) {
264 list_available_languages();
265 return 0;
266 }
267
268 script = strchr(str, ':');
269 if (script) {
270 len = script - str;
271 if (len >= PATH_MAX) {
272 fprintf(stderr, "invalid language specifier");
273 return -1;
274 }
275 strncpy(spec, str, len);
276 spec[len] = '\0';
277 scripting_ops = script_spec__lookup(spec);
278 if (!scripting_ops) {
279 fprintf(stderr, "invalid language specifier");
280 return -1;
281 }
282 script++;
283 } else {
284 script = str;
285 ext = strchr(script, '.');
286 if (!ext) {
287 fprintf(stderr, "invalid script extension");
288 return -1;
289 }
290 scripting_ops = script_spec__lookup(++ext);
291 if (!scripting_ops) {
292 fprintf(stderr, "invalid script extension");
293 return -1;
294 }
295 }
296
297 script_name = strdup(script);
298
299 return 0;
300}
301
108static const char * const annotate_usage[] = { 302static const char * const annotate_usage[] = {
109 "perf trace [<options>] <command>", 303 "perf trace [<options>] <command>",
110 NULL 304 NULL
@@ -117,13 +311,23 @@ static const struct option options[] = {
117 "be more verbose (show symbol address, etc)"), 311 "be more verbose (show symbol address, etc)"),
118 OPT_BOOLEAN('l', "latency", &latency_format, 312 OPT_BOOLEAN('l', "latency", &latency_format,
119 "show latency attributes (irqs/preemption disabled, etc)"), 313 "show latency attributes (irqs/preemption disabled, etc)"),
314 OPT_CALLBACK('s', "script", NULL, "name",
315 "script file name (lang:script name, script name, or *)",
316 parse_scriptname),
317 OPT_STRING('g', "gen-script", &generate_script_lang, "lang",
318 "generate perf-trace.xx script in specified language"),
319
120 OPT_END() 320 OPT_END()
121}; 321};
122 322
123int cmd_trace(int argc, const char **argv, const char *prefix __used) 323int cmd_trace(int argc, const char **argv, const char *prefix __used)
124{ 324{
325 int err;
326
125 symbol__init(0); 327 symbol__init(0);
126 328
329 setup_scripting();
330
127 argc = parse_options(argc, argv, options, annotate_usage, 0); 331 argc = parse_options(argc, argv, options, annotate_usage, 0);
128 if (argc) { 332 if (argc) {
129 /* 333 /*
@@ -136,5 +340,50 @@ int cmd_trace(int argc, const char **argv, const char *prefix __used)
136 340
137 setup_pager(); 341 setup_pager();
138 342
139 return __cmd_trace(); 343 if (generate_script_lang) {
344 struct stat perf_stat;
345
346 int input = open(input_name, O_RDONLY);
347 if (input < 0) {
348 perror("failed to open file");
349 exit(-1);
350 }
351
352 err = fstat(input, &perf_stat);
353 if (err < 0) {
354 perror("failed to stat file");
355 exit(-1);
356 }
357
358 if (!perf_stat.st_size) {
359 fprintf(stderr, "zero-sized file, nothing to do!\n");
360 exit(0);
361 }
362
363 scripting_ops = script_spec__lookup(generate_script_lang);
364 if (!scripting_ops) {
365 fprintf(stderr, "invalid language specifier");
366 return -1;
367 }
368
369 header = perf_header__new();
370 if (header == NULL)
371 return -1;
372
373 perf_header__read(header, input);
374 err = scripting_ops->generate_script("perf-trace");
375 goto out;
376 }
377
378 if (script_name) {
379 err = scripting_ops->start_script(script_name);
380 if (err)
381 goto out;
382 }
383
384 err = __cmd_trace();
385
386 cleanup_scripting();
387out:
388 return err;
140} 389}
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Context.c b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
new file mode 100644
index 00000000000..af78d9a52a7
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.c
@@ -0,0 +1,134 @@
1/*
2 * This file was generated automatically by ExtUtils::ParseXS version 2.18_02 from the
3 * contents of Context.xs. Do not edit this file, edit Context.xs instead.
4 *
5 * ANY CHANGES MADE HERE WILL BE LOST!
6 *
7 */
8
9#line 1 "Context.xs"
10/*
11 * Context.xs. XS interfaces for perf trace.
12 *
13 * Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
14 *
15 * This program is free software; you can redistribute it and/or modify
16 * it under the terms of the GNU General Public License as published by
17 * the Free Software Foundation; either version 2 of the License, or
18 * (at your option) any later version.
19 *
20 * This program is distributed in the hope that it will be useful,
21 * but WITHOUT ANY WARRANTY; without even the implied warranty of
22 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
23 * GNU General Public License for more details.
24 *
25 * You should have received a copy of the GNU General Public License
26 * along with this program; if not, write to the Free Software
27 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
28 *
29 */
30
31#include "EXTERN.h"
32#include "perl.h"
33#include "XSUB.h"
34#include "../../../util/trace-event-perl.h"
35
36#ifndef PERL_UNUSED_VAR
37# define PERL_UNUSED_VAR(var) if (0) var = var
38#endif
39
40#line 41 "Context.c"
41
42XS(XS_Perf__Trace__Context_common_pc); /* prototype to pass -Wmissing-prototypes */
43XS(XS_Perf__Trace__Context_common_pc)
44{
45#ifdef dVAR
46 dVAR; dXSARGS;
47#else
48 dXSARGS;
49#endif
50 if (items != 1)
51 Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_pc", "context");
52 PERL_UNUSED_VAR(cv); /* -W */
53 {
54 struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
55 int RETVAL;
56 dXSTARG;
57
58 RETVAL = common_pc(context);
59 XSprePUSH; PUSHi((IV)RETVAL);
60 }
61 XSRETURN(1);
62}
63
64
65XS(XS_Perf__Trace__Context_common_flags); /* prototype to pass -Wmissing-prototypes */
66XS(XS_Perf__Trace__Context_common_flags)
67{
68#ifdef dVAR
69 dVAR; dXSARGS;
70#else
71 dXSARGS;
72#endif
73 if (items != 1)
74 Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_flags", "context");
75 PERL_UNUSED_VAR(cv); /* -W */
76 {
77 struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
78 int RETVAL;
79 dXSTARG;
80
81 RETVAL = common_flags(context);
82 XSprePUSH; PUSHi((IV)RETVAL);
83 }
84 XSRETURN(1);
85}
86
87
88XS(XS_Perf__Trace__Context_common_lock_depth); /* prototype to pass -Wmissing-prototypes */
89XS(XS_Perf__Trace__Context_common_lock_depth)
90{
91#ifdef dVAR
92 dVAR; dXSARGS;
93#else
94 dXSARGS;
95#endif
96 if (items != 1)
97 Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_lock_depth", "context");
98 PERL_UNUSED_VAR(cv); /* -W */
99 {
100 struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
101 int RETVAL;
102 dXSTARG;
103
104 RETVAL = common_lock_depth(context);
105 XSprePUSH; PUSHi((IV)RETVAL);
106 }
107 XSRETURN(1);
108}
109
110#ifdef __cplusplus
111extern "C"
112#endif
113XS(boot_Perf__Trace__Context); /* prototype to pass -Wmissing-prototypes */
114XS(boot_Perf__Trace__Context)
115{
116#ifdef dVAR
117 dVAR; dXSARGS;
118#else
119 dXSARGS;
120#endif
121 const char* file = __FILE__;
122
123 PERL_UNUSED_VAR(cv); /* -W */
124 PERL_UNUSED_VAR(items); /* -W */
125 XS_VERSION_BOOTCHECK ;
126
127 newXSproto("Perf::Trace::Context::common_pc", XS_Perf__Trace__Context_common_pc, file, "$");
128 newXSproto("Perf::Trace::Context::common_flags", XS_Perf__Trace__Context_common_flags, file, "$");
129 newXSproto("Perf::Trace::Context::common_lock_depth", XS_Perf__Trace__Context_common_lock_depth, file, "$");
130 if (PL_unitcheckav)
131 call_list(PL_scopestack_ix, PL_unitcheckav);
132 XSRETURN_YES;
133}
134
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
new file mode 100644
index 00000000000..fb78006c165
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Context.xs
@@ -0,0 +1,41 @@
1/*
2 * Context.xs. XS interfaces for perf trace.
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 "EXTERN.h"
23#include "perl.h"
24#include "XSUB.h"
25#include "../../../util/trace-event-perl.h"
26
27MODULE = Perf::Trace::Context PACKAGE = Perf::Trace::Context
28PROTOTYPES: ENABLE
29
30int
31common_pc(context)
32 struct scripting_context * context
33
34int
35common_flags(context)
36 struct scripting_context * context
37
38int
39common_lock_depth(context)
40 struct scripting_context * context
41
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
new file mode 100644
index 00000000000..decdeb0f678
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL
@@ -0,0 +1,17 @@
1use 5.010000;
2use ExtUtils::MakeMaker;
3# See lib/ExtUtils/MakeMaker.pm for details of how to influence
4# the contents of the Makefile that is written.
5WriteMakefile(
6 NAME => 'Perf::Trace::Context',
7 VERSION_FROM => 'lib/Perf/Trace/Context.pm', # finds $VERSION
8 PREREQ_PM => {}, # e.g., Module::Name => 1.1
9 ($] >= 5.005 ? ## Add these new keywords supported since 5.005
10 (ABSTRACT_FROM => 'lib/Perf/Trace/Context.pm', # retrieve abstract from module
11 AUTHOR => 'Tom Zanussi <tzanussi@gmail.com>') : ()),
12 LIBS => [''], # e.g., '-lm'
13 DEFINE => '-I ../..', # e.g., '-DHAVE_SOMETHING'
14 INC => '-I.', # e.g., '-I. -I/usr/include/other'
15 # Un-comment this if you add C files to link with later:
16 OBJECT => 'Context.o', # link all the C files too
17);
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/README b/tools/perf/scripts/perl/Perf-Trace-Util/README
new file mode 100644
index 00000000000..9a970763079
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/README
@@ -0,0 +1,59 @@
1Perf-Trace-Util version 0.01
2============================
3
4This module contains utility functions for use with perf trace.
5
6Core.pm and Util.pm are pure Perl modules; Core.pm contains routines
7that the core perf support for Perl calls on and should always be
8'used', while Util.pm contains useful but optional utility functions
9that scripts may want to use. Context.pm contains the Perl->C
10interface that allows scripts to access data in the embedding perf
11executable; scripts wishing to do that should 'use Context.pm'.
12
13The Perl->C perf interface is completely driven by Context.xs. If you
14want to add new Perl functions that end up accessing C data in the
15perf executable, you add desciptions of the new functions here.
16scripting_context is a pointer to the perf data in the perf executable
17that you want to access - it's passed as the second parameter,
18$context, to all handler functions.
19
20After you do that:
21
22 perl Makefile.PL # to create a Makefile for the next step
23 make # to create Context.c
24
25 edit Context.c to add const to the char* file = __FILE__ line in
26 XS(boot_Perf__Trace__Context) to silence a warning/error.
27
28 You can delete the Makefile, object files and anything else that was
29 generated e.g. blib and shared library, etc, except for of course
30 Context.c
31
32 You should then be able to run the normal perf make as usual.
33
34INSTALLATION
35
36Building perf with perf trace Perl scripting should install this
37module in the right place.
38
39You should make sure libperl and ExtUtils/Embed.pm are installed first
40e.g. apt-get install libperl-dev or yum install perl-ExtUtils-Embed.
41
42DEPENDENCIES
43
44This module requires these other modules and libraries:
45
46 None
47
48COPYRIGHT AND LICENCE
49
50Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com>
51
52This library is free software; you can redistribute it and/or modify
53it under the same terms as Perl itself, either Perl version 5.10.0 or,
54at your option, any later version of Perl 5 you may have available.
55
56Alternatively, this software may be distributed under the terms of the
57GNU General Public License ("GPL") version 2 as published by the Free
58Software Foundation.
59
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
new file mode 100644
index 00000000000..6c7f3659cb1
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm
@@ -0,0 +1,55 @@
1package Perf::Trace::Context;
2
3use 5.010000;
4use strict;
5use warnings;
6
7require Exporter;
8
9our @ISA = qw(Exporter);
10
11our %EXPORT_TAGS = ( 'all' => [ qw(
12) ] );
13
14our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15
16our @EXPORT = qw(
17 common_pc common_flags common_lock_depth
18);
19
20our $VERSION = '0.01';
21
22require XSLoader;
23XSLoader::load('Perf::Trace::Context', $VERSION);
24
251;
26__END__
27=head1 NAME
28
29Perf::Trace::Context - Perl extension for accessing functions in perf.
30
31=head1 SYNOPSIS
32
33 use Perf::Trace::Context;
34
35=head1 SEE ALSO
36
37Perf (trace) documentation
38
39=head1 AUTHOR
40
41Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
42
43=head1 COPYRIGHT AND LICENSE
44
45Copyright (C) 2009 by Tom Zanussi
46
47This library is free software; you can redistribute it and/or modify
48it under the same terms as Perl itself, either Perl version 5.10.0 or,
49at your option, any later version of Perl 5 you may have available.
50
51Alternatively, this software may be distributed under the terms of the
52GNU General Public License ("GPL") version 2 as published by the Free
53Software Foundation.
54
55=cut
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm
new file mode 100644
index 00000000000..9df376a9f62
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm
@@ -0,0 +1,192 @@
1package Perf::Trace::Core;
2
3use 5.010000;
4use strict;
5use warnings;
6
7require Exporter;
8
9our @ISA = qw(Exporter);
10
11our %EXPORT_TAGS = ( 'all' => [ qw(
12) ] );
13
14our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15
16our @EXPORT = qw(
17define_flag_field define_flag_value flag_str dump_flag_fields
18define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
19trace_flag_str
20);
21
22our $VERSION = '0.01';
23
24my %trace_flags = (0x00 => "NONE",
25 0x01 => "IRQS_OFF",
26 0x02 => "IRQS_NOSUPPORT",
27 0x04 => "NEED_RESCHED",
28 0x08 => "HARDIRQ",
29 0x10 => "SOFTIRQ");
30
31sub trace_flag_str
32{
33 my ($value) = @_;
34
35 my $string;
36
37 my $print_delim = 0;
38
39 foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
40 if (!$value && !$idx) {
41 $string .= "NONE";
42 last;
43 }
44
45 if ($idx && ($value & $idx) == $idx) {
46 if ($print_delim) {
47 $string .= " | ";
48 }
49 $string .= "$trace_flags{$idx}";
50 $print_delim = 1;
51 $value &= ~$idx;
52 }
53 }
54
55 return $string;
56}
57
58my %flag_fields;
59my %symbolic_fields;
60
61sub flag_str
62{
63 my ($event_name, $field_name, $value) = @_;
64
65 my $string;
66
67 if ($flag_fields{$event_name}{$field_name}) {
68 my $print_delim = 0;
69 foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
70 if (!$value && !$idx) {
71 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
72 last;
73 }
74 if ($idx && ($value & $idx) == $idx) {
75 if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
76 $string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
77 }
78 $string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
79 $print_delim = 1;
80 $value &= ~$idx;
81 }
82 }
83 }
84
85 return $string;
86}
87
88sub define_flag_field
89{
90 my ($event_name, $field_name, $delim) = @_;
91
92 $flag_fields{$event_name}{$field_name}{"delim"} = $delim;
93}
94
95sub define_flag_value
96{
97 my ($event_name, $field_name, $value, $field_str) = @_;
98
99 $flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
100}
101
102sub dump_flag_fields
103{
104 for my $event (keys %flag_fields) {
105 print "event $event:\n";
106 for my $field (keys %{$flag_fields{$event}}) {
107 print " field: $field:\n";
108 print " delim: $flag_fields{$event}{$field}{'delim'}\n";
109 foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
110 print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
111 }
112 }
113 }
114}
115
116sub symbol_str
117{
118 my ($event_name, $field_name, $value) = @_;
119
120 if ($symbolic_fields{$event_name}{$field_name}) {
121 foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
122 if (!$value && !$idx) {
123 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
124 last;
125 }
126 if ($value == $idx) {
127 return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
128 }
129 }
130 }
131
132 return undef;
133}
134
135sub define_symbolic_field
136{
137 my ($event_name, $field_name) = @_;
138
139 # nothing to do, really
140}
141
142sub define_symbolic_value
143{
144 my ($event_name, $field_name, $value, $field_str) = @_;
145
146 $symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
147}
148
149sub dump_symbolic_fields
150{
151 for my $event (keys %symbolic_fields) {
152 print "event $event:\n";
153 for my $field (keys %{$symbolic_fields{$event}}) {
154 print " field: $field:\n";
155 foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
156 print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
157 }
158 }
159 }
160}
161
1621;
163__END__
164=head1 NAME
165
166Perf::Trace::Core - Perl extension for perf trace
167
168=head1 SYNOPSIS
169
170 use Perf::Trace::Core
171
172=head1 SEE ALSO
173
174Perf (trace) documentation
175
176=head1 AUTHOR
177
178Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
179
180=head1 COPYRIGHT AND LICENSE
181
182Copyright (C) 2009 by Tom Zanussi
183
184This library is free software; you can redistribute it and/or modify
185it under the same terms as Perl itself, either Perl version 5.10.0 or,
186at your option, any later version of Perl 5 you may have available.
187
188Alternatively, this software may be distributed under the terms of the
189GNU General Public License ("GPL") version 2 as published by the Free
190Software Foundation.
191
192=cut
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
new file mode 100644
index 00000000000..052f132ced2
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm
@@ -0,0 +1,88 @@
1package Perf::Trace::Util;
2
3use 5.010000;
4use strict;
5use warnings;
6
7require Exporter;
8
9our @ISA = qw(Exporter);
10
11our %EXPORT_TAGS = ( 'all' => [ qw(
12) ] );
13
14our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
15
16our @EXPORT = qw(
17avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs
18);
19
20our $VERSION = '0.01';
21
22sub avg
23{
24 my ($total, $n) = @_;
25
26 return $total / $n;
27}
28
29my $NSECS_PER_SEC = 1000000000;
30
31sub nsecs
32{
33 my ($secs, $nsecs) = @_;
34
35 return $secs * $NSECS_PER_SEC + $nsecs;
36}
37
38sub nsecs_secs {
39 my ($nsecs) = @_;
40
41 return $nsecs / $NSECS_PER_SEC;
42}
43
44sub nsecs_nsecs {
45 my ($nsecs) = @_;
46
47 return $nsecs - nsecs_secs($nsecs);
48}
49
50sub nsecs_str {
51 my ($nsecs) = @_;
52
53 my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));
54
55 return $str;
56}
57
581;
59__END__
60=head1 NAME
61
62Perf::Trace::Util - Perl extension for perf trace
63
64=head1 SYNOPSIS
65
66 use Perf::Trace::Util;
67
68=head1 SEE ALSO
69
70Perf (trace) documentation
71
72=head1 AUTHOR
73
74Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
75
76=head1 COPYRIGHT AND LICENSE
77
78Copyright (C) 2009 by Tom Zanussi
79
80This library is free software; you can redistribute it and/or modify
81it under the same terms as Perl itself, either Perl version 5.10.0 or,
82at your option, any later version of Perl 5 you may have available.
83
84Alternatively, this software may be distributed under the terms of the
85GNU General Public License ("GPL") version 2 as published by the Free
86Software Foundation.
87
88=cut
diff --git a/tools/perf/scripts/perl/Perf-Trace-Util/typemap b/tools/perf/scripts/perl/Perf-Trace-Util/typemap
new file mode 100644
index 00000000000..840836804aa
--- /dev/null
+++ b/tools/perf/scripts/perl/Perf-Trace-Util/typemap
@@ -0,0 +1 @@
struct scripting_context * T_PTR
diff --git a/tools/perf/scripts/perl/bin/check-perf-trace-record b/tools/perf/scripts/perl/bin/check-perf-trace-record
new file mode 100644
index 00000000000..c7ec5de2f53
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/check-perf-trace-record
@@ -0,0 +1,7 @@
1#!/bin/bash
2perf record -c 1 -f -a -M -R -e kmem:kmalloc -e irq:softirq_entry
3
4
5
6
7
diff --git a/tools/perf/scripts/perl/bin/check-perf-trace-report b/tools/perf/scripts/perl/bin/check-perf-trace-report
new file mode 100644
index 00000000000..89948b01502
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/check-perf-trace-report
@@ -0,0 +1,5 @@
1#!/bin/bash
2perf trace -s ~/libexec/perf-core/scripts/perl/check-perf-trace.pl
3
4
5
diff --git a/tools/perf/scripts/perl/bin/rw-by-file-record b/tools/perf/scripts/perl/bin/rw-by-file-record
new file mode 100644
index 00000000000..b25056ebf96
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-file-record
@@ -0,0 +1,2 @@
1#!/bin/bash
2perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_enter_write
diff --git a/tools/perf/scripts/perl/bin/rw-by-file-report b/tools/perf/scripts/perl/bin/rw-by-file-report
new file mode 100644
index 00000000000..f5dcf9cb5bd
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-file-report
@@ -0,0 +1,5 @@
1#!/bin/bash
2perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl
3
4
5
diff --git a/tools/perf/scripts/perl/bin/rw-by-pid-record b/tools/perf/scripts/perl/bin/rw-by-pid-record
new file mode 100644
index 00000000000..8903979c5b6
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-pid-record
@@ -0,0 +1,2 @@
1#!/bin/bash
2perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_exit_read -e syscalls:sys_enter_write -e syscalls:sys_exit_write
diff --git a/tools/perf/scripts/perl/bin/rw-by-pid-report b/tools/perf/scripts/perl/bin/rw-by-pid-report
new file mode 100644
index 00000000000..cea16f78a3a
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/rw-by-pid-report
@@ -0,0 +1,5 @@
1#!/bin/bash
2perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl
3
4
5
diff --git a/tools/perf/scripts/perl/bin/wakeup-latency-record b/tools/perf/scripts/perl/bin/wakeup-latency-record
new file mode 100644
index 00000000000..6abedda911a
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/wakeup-latency-record
@@ -0,0 +1,6 @@
1#!/bin/bash
2perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup
3
4
5
6
diff --git a/tools/perf/scripts/perl/bin/wakeup-latency-report b/tools/perf/scripts/perl/bin/wakeup-latency-report
new file mode 100644
index 00000000000..85769dc456e
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/wakeup-latency-report
@@ -0,0 +1,5 @@
1#!/bin/bash
2perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl
3
4
5
diff --git a/tools/perf/scripts/perl/bin/workqueue-stats-record b/tools/perf/scripts/perl/bin/workqueue-stats-record
new file mode 100644
index 00000000000..fce6637b19b
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/workqueue-stats-record
@@ -0,0 +1,2 @@
1#!/bin/bash
2perf record -c 1 -f -a -M -R -e workqueue:workqueue_creation -e workqueue:workqueue_destruction -e workqueue:workqueue_execution -e workqueue:workqueue_insertion
diff --git a/tools/perf/scripts/perl/bin/workqueue-stats-report b/tools/perf/scripts/perl/bin/workqueue-stats-report
new file mode 100644
index 00000000000..aa68435be92
--- /dev/null
+++ b/tools/perf/scripts/perl/bin/workqueue-stats-report
@@ -0,0 +1,6 @@
1#!/bin/bash
2perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl
3
4
5
6
diff --git a/tools/perf/scripts/perl/check-perf-trace.pl b/tools/perf/scripts/perl/check-perf-trace.pl
new file mode 100644
index 00000000000..4e7dc0a407a
--- /dev/null
+++ b/tools/perf/scripts/perl/check-perf-trace.pl
@@ -0,0 +1,106 @@
1# perf trace event handlers, generated by perf trace -g perl
2# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
3# Licensed under the terms of the GNU GPL License version 2
4
5# This script tests basic functionality such as flag and symbol
6# strings, common_xxx() calls back into perf, begin, end, unhandled
7# events, etc. Basically, if this script runs successfully and
8# displays expected results, perl scripting support should be ok.
9
10use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
11use lib "./Perf-Trace-Util/lib";
12use Perf::Trace::Core;
13use Perf::Trace::Context;
14use Perf::Trace::Util;
15
16sub trace_begin
17{
18 print "trace_begin\n";
19}
20
21sub trace_end
22{
23 print "trace_end\n";
24
25 print_unhandled();
26}
27
28sub irq::softirq_entry
29{
30 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
31 $common_pid, $common_comm,
32 $vec) = @_;
33
34 print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
35 $common_pid, $common_comm);
36
37 print_uncommon($context);
38
39 printf("vec=%s\n",
40 symbol_str("irq::softirq_entry", "vec", $vec));
41}
42
43sub kmem::kmalloc
44{
45 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
46 $common_pid, $common_comm,
47 $call_site, $ptr, $bytes_req, $bytes_alloc,
48 $gfp_flags) = @_;
49
50 print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
51 $common_pid, $common_comm);
52
53 print_uncommon($context);
54
55 printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
56 "gfp_flags=%s\n",
57 $call_site, $ptr, $bytes_req, $bytes_alloc,
58
59 flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
60}
61
62# print trace fields not included in handler args
63sub print_uncommon
64{
65 my ($context) = @_;
66
67 printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
68 common_pc($context), trace_flag_str(common_flags($context)),
69 common_lock_depth($context));
70
71}
72
73my %unhandled;
74
75sub print_unhandled
76{
77 if ((scalar keys %unhandled) == 0) {
78 return;
79 }
80
81 print "\nunhandled events:\n\n";
82
83 printf("%-40s %10s\n", "event", "count");
84 printf("%-40s %10s\n", "----------------------------------------",
85 "-----------");
86
87 foreach my $event_name (keys %unhandled) {
88 printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
89 }
90}
91
92sub trace_unhandled
93{
94 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
95 $common_pid, $common_comm) = @_;
96
97 $unhandled{$event_name}++;
98}
99
100sub print_header
101{
102 my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
103
104 printf("%-20s %5u %05u.%09u %8u %-20s ",
105 $event_name, $cpu, $secs, $nsecs, $pid, $comm);
106}
diff --git a/tools/perf/scripts/perl/rw-by-file.pl b/tools/perf/scripts/perl/rw-by-file.pl
new file mode 100644
index 00000000000..61f91561d84
--- /dev/null
+++ b/tools/perf/scripts/perl/rw-by-file.pl
@@ -0,0 +1,105 @@
1#!/usr/bin/perl -w
2# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
3# Licensed under the terms of the GNU GPL License version 2
4
5# Display r/w activity for files read/written to for a given program
6
7# The common_* event handler fields are the most useful fields common to
8# all events. They don't necessarily correspond to the 'common_*' fields
9# in the status files. Those fields not available as handler params can
10# be retrieved via script functions of the form get_common_*().
11
12use 5.010000;
13use strict;
14use warnings;
15
16use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
17use lib "./Perf-Trace-Util/lib";
18use Perf::Trace::Core;
19use Perf::Trace::Util;
20
21# change this to the comm of the program you're interested in
22my $for_comm = "perf";
23
24my %reads;
25my %writes;
26
27sub syscalls::sys_enter_read
28{
29 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
30 $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
31
32 if ($common_comm eq $for_comm) {
33 $reads{$fd}{bytes_requested} += $count;
34 $reads{$fd}{total_reads}++;
35 }
36}
37
38sub syscalls::sys_enter_write
39{
40 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
41 $common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
42
43 if ($common_comm eq $for_comm) {
44 $writes{$fd}{bytes_written} += $count;
45 $writes{$fd}{total_writes}++;
46 }
47}
48
49sub trace_end
50{
51 printf("file read counts for $for_comm:\n\n");
52
53 printf("%6s %10s %10s\n", "fd", "# reads", "bytes_requested");
54 printf("%6s %10s %10s\n", "------", "----------", "-----------");
55
56 foreach my $fd (sort {$reads{$b}{bytes_requested} <=>
57 $reads{$a}{bytes_requested}} keys %reads) {
58 my $total_reads = $reads{$fd}{total_reads};
59 my $bytes_requested = $reads{$fd}{bytes_requested};
60 printf("%6u %10u %10u\n", $fd, $total_reads, $bytes_requested);
61 }
62
63 printf("\nfile write counts for $for_comm:\n\n");
64
65 printf("%6s %10s %10s\n", "fd", "# writes", "bytes_written");
66 printf("%6s %10s %10s\n", "------", "----------", "-----------");
67
68 foreach my $fd (sort {$writes{$b}{bytes_written} <=>
69 $writes{$a}{bytes_written}} keys %writes) {
70 my $total_writes = $writes{$fd}{total_writes};
71 my $bytes_written = $writes{$fd}{bytes_written};
72 printf("%6u %10u %10u\n", $fd, $total_writes, $bytes_written);
73 }
74
75 print_unhandled();
76}
77
78my %unhandled;
79
80sub print_unhandled
81{
82 if ((scalar keys %unhandled) == 0) {
83 return;
84 }
85
86 print "\nunhandled events:\n\n";
87
88 printf("%-40s %10s\n", "event", "count");
89 printf("%-40s %10s\n", "----------------------------------------",
90 "-----------");
91
92 foreach my $event_name (keys %unhandled) {
93 printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
94 }
95}
96
97sub trace_unhandled
98{
99 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
100 $common_pid, $common_comm) = @_;
101
102 $unhandled{$event_name}++;
103}
104
105
diff --git a/tools/perf/scripts/perl/rw-by-pid.pl b/tools/perf/scripts/perl/rw-by-pid.pl
new file mode 100644
index 00000000000..da601fae1a0
--- /dev/null
+++ b/tools/perf/scripts/perl/rw-by-pid.pl
@@ -0,0 +1,170 @@
1#!/usr/bin/perl -w
2# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
3# Licensed under the terms of the GNU GPL License version 2
4
5# Display r/w activity for all processes
6
7# The common_* event handler fields are the most useful fields common to
8# all events. They don't necessarily correspond to the 'common_*' fields
9# in the status files. Those fields not available as handler params can
10# be retrieved via script functions of the form get_common_*().
11
12use 5.010000;
13use strict;
14use warnings;
15
16use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
17use lib "./Perf-Trace-Util/lib";
18use Perf::Trace::Core;
19use Perf::Trace::Util;
20
21my %reads;
22my %writes;
23
24sub syscalls::sys_exit_read
25{
26 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
27 $common_pid, $common_comm,
28 $nr, $ret) = @_;
29
30 if ($ret > 0) {
31 $reads{$common_pid}{bytes_read} += $ret;
32 } else {
33 if (!defined ($reads{$common_pid}{bytes_read})) {
34 $reads{$common_pid}{bytes_read} = 0;
35 }
36 $reads{$common_pid}{errors}{$ret}++;
37 }
38}
39
40sub syscalls::sys_enter_read
41{
42 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
43 $common_pid, $common_comm,
44 $nr, $fd, $buf, $count) = @_;
45
46 $reads{$common_pid}{bytes_requested} += $count;
47 $reads{$common_pid}{total_reads}++;
48 $reads{$common_pid}{comm} = $common_comm;
49}
50
51sub syscalls::sys_exit_write
52{
53 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
54 $common_pid, $common_comm,
55 $nr, $ret) = @_;
56
57 if ($ret <= 0) {
58 $writes{$common_pid}{errors}{$ret}++;
59 }
60}
61
62sub syscalls::sys_enter_write
63{
64 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
65 $common_pid, $common_comm,
66 $nr, $fd, $buf, $count) = @_;
67
68 $writes{$common_pid}{bytes_written} += $count;
69 $writes{$common_pid}{total_writes}++;
70 $writes{$common_pid}{comm} = $common_comm;
71}
72
73sub trace_end
74{
75 printf("read counts by pid:\n\n");
76
77 printf("%6s %20s %10s %10s %10s\n", "pid", "comm",
78 "# reads", "bytes_requested", "bytes_read");
79 printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------",
80 "-----------", "----------", "----------");
81
82 foreach my $pid (sort {$reads{$b}{bytes_read} <=>
83 $reads{$a}{bytes_read}} keys %reads) {
84 my $comm = $reads{$pid}{comm};
85 my $total_reads = $reads{$pid}{total_reads};
86 my $bytes_requested = $reads{$pid}{bytes_requested};
87 my $bytes_read = $reads{$pid}{bytes_read};
88
89 printf("%6s %-20s %10s %10s %10s\n", $pid, $comm,
90 $total_reads, $bytes_requested, $bytes_read);
91 }
92
93 printf("\nfailed reads by pid:\n\n");
94
95 printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
96 printf("%6s %20s %6s %10s\n", "------", "--------------------",
97 "------", "----------");
98
99 foreach my $pid (keys %reads) {
100 my $comm = $reads{$pid}{comm};
101 foreach my $err (sort {$reads{$b}{comm} cmp $reads{$a}{comm}}
102 keys %{$reads{$pid}{errors}}) {
103 my $errors = $reads{$pid}{errors}{$err};
104
105 printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
106 }
107 }
108
109 printf("\nwrite counts by pid:\n\n");
110
111 printf("%6s %20s %10s %10s\n", "pid", "comm",
112 "# writes", "bytes_written");
113 printf("%6s %-20s %10s %10s\n", "------", "--------------------",
114 "-----------", "----------");
115
116 foreach my $pid (sort {$writes{$b}{bytes_written} <=>
117 $writes{$a}{bytes_written}} keys %writes) {
118 my $comm = $writes{$pid}{comm};
119 my $total_writes = $writes{$pid}{total_writes};
120 my $bytes_written = $writes{$pid}{bytes_written};
121
122 printf("%6s %-20s %10s %10s\n", $pid, $comm,
123 $total_writes, $bytes_written);
124 }
125
126 printf("\nfailed writes by pid:\n\n");
127
128 printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
129 printf("%6s %20s %6s %10s\n", "------", "--------------------",
130 "------", "----------");
131
132 foreach my $pid (keys %writes) {
133 my $comm = $writes{$pid}{comm};
134 foreach my $err (sort {$writes{$b}{comm} cmp $writes{$a}{comm}}
135 keys %{$writes{$pid}{errors}}) {
136 my $errors = $writes{$pid}{errors}{$err};
137
138 printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
139 }
140 }
141
142 print_unhandled();
143}
144
145my %unhandled;
146
147sub print_unhandled
148{
149 if ((scalar keys %unhandled) == 0) {
150 return;
151 }
152
153 print "\nunhandled events:\n\n";
154
155 printf("%-40s %10s\n", "event", "count");
156 printf("%-40s %10s\n", "----------------------------------------",
157 "-----------");
158
159 foreach my $event_name (keys %unhandled) {
160 printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
161 }
162}
163
164sub trace_unhandled
165{
166 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
167 $common_pid, $common_comm) = @_;
168
169 $unhandled{$event_name}++;
170}
diff --git a/tools/perf/scripts/perl/wakeup-latency.pl b/tools/perf/scripts/perl/wakeup-latency.pl
new file mode 100644
index 00000000000..ed58ef284e2
--- /dev/null
+++ b/tools/perf/scripts/perl/wakeup-latency.pl
@@ -0,0 +1,103 @@
1#!/usr/bin/perl -w
2# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
3# Licensed under the terms of the GNU GPL License version 2
4
5# Display avg/min/max wakeup latency
6
7# The common_* event handler fields are the most useful fields common to
8# all events. They don't necessarily correspond to the 'common_*' fields
9# in the status files. Those fields not available as handler params can
10# be retrieved via script functions of the form get_common_*().
11
12use 5.010000;
13use strict;
14use warnings;
15
16use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
17use lib "./Perf-Trace-Util/lib";
18use Perf::Trace::Core;
19use Perf::Trace::Util;
20
21my %last_wakeup;
22
23my $max_wakeup_latency;
24my $min_wakeup_latency;
25my $total_wakeup_latency;
26my $total_wakeups;
27
28sub sched::sched_switch
29{
30 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
31 $common_pid, $common_comm,
32 $prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid,
33 $next_prio) = @_;
34
35 my $wakeup_ts = $last_wakeup{$common_cpu}{ts};
36 if ($wakeup_ts) {
37 my $switch_ts = nsecs($common_secs, $common_nsecs);
38 my $wakeup_latency = $switch_ts - $wakeup_ts;
39 if ($wakeup_latency > $max_wakeup_latency) {
40 $max_wakeup_latency = $wakeup_latency;
41 }
42 if ($wakeup_latency < $min_wakeup_latency) {
43 $min_wakeup_latency = $wakeup_latency;
44 }
45 $total_wakeup_latency += $wakeup_latency;
46 $total_wakeups++;
47 }
48 $last_wakeup{$common_cpu}{ts} = 0;
49}
50
51sub sched::sched_wakeup
52{
53 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
54 $common_pid, $common_comm,
55 $comm, $pid, $prio, $success, $target_cpu) = @_;
56
57 $last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs);
58}
59
60sub trace_begin
61{
62 $min_wakeup_latency = 1000000000;
63 $max_wakeup_latency = 0;
64}
65
66sub trace_end
67{
68 printf("wakeup_latency stats:\n\n");
69 print "total_wakeups: $total_wakeups\n";
70 printf("avg_wakeup_latency (ns): %u\n",
71 avg($total_wakeup_latency, $total_wakeups));
72 printf("min_wakeup_latency (ns): %u\n", $min_wakeup_latency);
73 printf("max_wakeup_latency (ns): %u\n", $max_wakeup_latency);
74
75 print_unhandled();
76}
77
78my %unhandled;
79
80sub print_unhandled
81{
82 if ((scalar keys %unhandled) == 0) {
83 return;
84 }
85
86 print "\nunhandled events:\n\n";
87
88 printf("%-40s %10s\n", "event", "count");
89 printf("%-40s %10s\n", "----------------------------------------",
90 "-----------");
91
92 foreach my $event_name (keys %unhandled) {
93 printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
94 }
95}
96
97sub trace_unhandled
98{
99 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
100 $common_pid, $common_comm) = @_;
101
102 $unhandled{$event_name}++;
103}
diff --git a/tools/perf/scripts/perl/workqueue-stats.pl b/tools/perf/scripts/perl/workqueue-stats.pl
new file mode 100644
index 00000000000..511302c8a49
--- /dev/null
+++ b/tools/perf/scripts/perl/workqueue-stats.pl
@@ -0,0 +1,129 @@
1#!/usr/bin/perl -w
2# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
3# Licensed under the terms of the GNU GPL License version 2
4
5# Displays workqueue stats
6#
7# Usage:
8#
9# perf record -c 1 -f -a -R -e workqueue:workqueue_creation -e
10# workqueue:workqueue_destruction -e workqueue:workqueue_execution
11# -e workqueue:workqueue_insertion
12#
13# perf trace -p -s tools/perf/scripts/perl/workqueue-stats.pl
14
15use 5.010000;
16use strict;
17use warnings;
18
19use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
20use lib "./Perf-Trace-Util/lib";
21use Perf::Trace::Core;
22use Perf::Trace::Util;
23
24my @cpus;
25
26sub workqueue::workqueue_destruction
27{
28 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
29 $common_pid, $common_comm,
30 $thread_comm, $thread_pid) = @_;
31
32 $cpus[$common_cpu]{$thread_pid}{destroyed}++;
33 $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
34}
35
36sub workqueue::workqueue_creation
37{
38 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
39 $common_pid, $common_comm,
40 $thread_comm, $thread_pid, $cpu) = @_;
41
42 $cpus[$common_cpu]{$thread_pid}{created}++;
43 $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
44}
45
46sub workqueue::workqueue_execution
47{
48 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
49 $common_pid, $common_comm,
50 $thread_comm, $thread_pid, $func) = @_;
51
52 $cpus[$common_cpu]{$thread_pid}{executed}++;
53 $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
54}
55
56sub workqueue::workqueue_insertion
57{
58 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
59 $common_pid, $common_comm,
60 $thread_comm, $thread_pid, $func) = @_;
61
62 $cpus[$common_cpu]{$thread_pid}{inserted}++;
63 $cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
64}
65
66sub trace_end
67{
68 print "workqueue work stats:\n\n";
69 my $cpu = 0;
70 printf("%3s %6s %6s\t%-20s\n", "cpu", "ins", "exec", "name");
71 printf("%3s %6s %6s\t%-20s\n", "---", "---", "----", "----");
72 foreach my $pidhash (@cpus) {
73 while ((my $pid, my $wqhash) = each %$pidhash) {
74 my $ins = $$wqhash{'inserted'};
75 my $exe = $$wqhash{'executed'};
76 my $comm = $$wqhash{'comm'};
77 if ($ins || $exe) {
78 printf("%3u %6u %6u\t%-20s\n", $cpu, $ins, $exe, $comm);
79 }
80 }
81 $cpu++;
82 }
83
84 $cpu = 0;
85 print "\nworkqueue lifecycle stats:\n\n";
86 printf("%3s %6s %6s\t%-20s\n", "cpu", "created", "destroyed", "name");
87 printf("%3s %6s %6s\t%-20s\n", "---", "-------", "---------", "----");
88 foreach my $pidhash (@cpus) {
89 while ((my $pid, my $wqhash) = each %$pidhash) {
90 my $created = $$wqhash{'created'};
91 my $destroyed = $$wqhash{'destroyed'};
92 my $comm = $$wqhash{'comm'};
93 if ($created || $destroyed) {
94 printf("%3u %6u %6u\t%-20s\n", $cpu, $created, $destroyed,
95 $comm);
96 }
97 }
98 $cpu++;
99 }
100
101 print_unhandled();
102}
103
104my %unhandled;
105
106sub print_unhandled
107{
108 if ((scalar keys %unhandled) == 0) {
109 return;
110 }
111
112 print "\nunhandled events:\n\n";
113
114 printf("%-40s %10s\n", "event", "count");
115 printf("%-40s %10s\n", "----------------------------------------",
116 "-----------");
117
118 foreach my $event_name (keys %unhandled) {
119 printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
120 }
121}
122
123sub trace_unhandled
124{
125 my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
126 $common_pid, $common_comm) = @_;
127
128 $unhandled{$event_name}++;
129}
diff --git a/tools/perf/util/trace-event-parse.c b/tools/perf/util/trace-event-parse.c
index 7021dc1b0ca..0302405aa2c 100644
--- a/tools/perf/util/trace-event-parse.c
+++ b/tools/perf/util/trace-event-parse.c
@@ -48,6 +48,11 @@ static unsigned long long input_buf_siz;
48 48
49static int cpus; 49static int cpus;
50static int long_size; 50static int long_size;
51static int is_flag_field;
52static int is_symbolic_field;
53
54static struct format_field *
55find_any_field(struct event *event, const char *name);
51 56
52static void init_input_buf(char *buf, unsigned long long size) 57static void init_input_buf(char *buf, unsigned long long size)
53{ 58{
@@ -1301,6 +1306,16 @@ process_entry(struct event *event __unused, struct print_arg *arg,
1301 arg->type = PRINT_FIELD; 1306 arg->type = PRINT_FIELD;
1302 arg->field.name = field; 1307 arg->field.name = field;
1303 1308
1309 if (is_flag_field) {
1310 arg->field.field = find_any_field(event, arg->field.name);
1311 arg->field.field->flags |= FIELD_IS_FLAG;
1312 is_flag_field = 0;
1313 } else if (is_symbolic_field) {
1314 arg->field.field = find_any_field(event, arg->field.name);
1315 arg->field.field->flags |= FIELD_IS_SYMBOLIC;
1316 is_symbolic_field = 0;
1317 }
1318
1304 type = read_token(&token); 1319 type = read_token(&token);
1305 *tok = token; 1320 *tok = token;
1306 1321
@@ -1668,9 +1683,11 @@ process_arg_token(struct event *event, struct print_arg *arg,
1668 type = process_entry(event, arg, &token); 1683 type = process_entry(event, arg, &token);
1669 } else if (strcmp(token, "__print_flags") == 0) { 1684 } else if (strcmp(token, "__print_flags") == 0) {
1670 free_token(token); 1685 free_token(token);
1686 is_flag_field = 1;
1671 type = process_flags(event, arg, &token); 1687 type = process_flags(event, arg, &token);
1672 } else if (strcmp(token, "__print_symbolic") == 0) { 1688 } else if (strcmp(token, "__print_symbolic") == 0) {
1673 free_token(token); 1689 free_token(token);
1690 is_symbolic_field = 1;
1674 type = process_symbols(event, arg, &token); 1691 type = process_symbols(event, arg, &token);
1675 } else if (strcmp(token, "__get_str") == 0) { 1692 } else if (strcmp(token, "__get_str") == 0) {
1676 free_token(token); 1693 free_token(token);
@@ -1871,7 +1888,7 @@ find_any_field(struct event *event, const char *name)
1871 return find_field(event, name); 1888 return find_field(event, name);
1872} 1889}
1873 1890
1874static unsigned long long read_size(void *ptr, int size) 1891unsigned long long read_size(void *ptr, int size)
1875{ 1892{
1876 switch (size) { 1893 switch (size) {
1877 case 1: 1894 case 1:
@@ -1956,7 +1973,7 @@ int trace_parse_common_type(void *data)
1956 "common_type"); 1973 "common_type");
1957} 1974}
1958 1975
1959static int parse_common_pid(void *data) 1976int trace_parse_common_pid(void *data)
1960{ 1977{
1961 static int pid_offset; 1978 static int pid_offset;
1962 static int pid_size; 1979 static int pid_size;
@@ -1965,7 +1982,7 @@ static int parse_common_pid(void *data)
1965 "common_pid"); 1982 "common_pid");
1966} 1983}
1967 1984
1968static int parse_common_pc(void *data) 1985int parse_common_pc(void *data)
1969{ 1986{
1970 static int pc_offset; 1987 static int pc_offset;
1971 static int pc_size; 1988 static int pc_size;
@@ -1974,7 +1991,7 @@ static int parse_common_pc(void *data)
1974 "common_preempt_count"); 1991 "common_preempt_count");
1975} 1992}
1976 1993
1977static int parse_common_flags(void *data) 1994int parse_common_flags(void *data)
1978{ 1995{
1979 static int flags_offset; 1996 static int flags_offset;
1980 static int flags_size; 1997 static int flags_size;
@@ -1983,7 +2000,7 @@ static int parse_common_flags(void *data)
1983 "common_flags"); 2000 "common_flags");
1984} 2001}
1985 2002
1986static int parse_common_lock_depth(void *data) 2003int parse_common_lock_depth(void *data)
1987{ 2004{
1988 static int ld_offset; 2005 static int ld_offset;
1989 static int ld_size; 2006 static int ld_size;
@@ -2008,6 +2025,14 @@ struct event *trace_find_event(int id)
2008 return event; 2025 return event;
2009} 2026}
2010 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
2011static unsigned long long eval_num_arg(void *data, int size, 2036static unsigned long long eval_num_arg(void *data, int size,
2012 struct event *event, struct print_arg *arg) 2037 struct event *event, struct print_arg *arg)
2013{ 2038{
@@ -2147,7 +2172,7 @@ static const struct flag flags[] = {
2147 { "HRTIMER_RESTART", 1 }, 2172 { "HRTIMER_RESTART", 1 },
2148}; 2173};
2149 2174
2150static unsigned long long eval_flag(const char *flag) 2175unsigned long long eval_flag(const char *flag)
2151{ 2176{
2152 int i; 2177 int i;
2153 2178
@@ -2677,7 +2702,7 @@ get_return_for_leaf(int cpu, int cur_pid, unsigned long long cur_func,
2677 if (!(event->flags & EVENT_FL_ISFUNCRET)) 2702 if (!(event->flags & EVENT_FL_ISFUNCRET))
2678 return NULL; 2703 return NULL;
2679 2704
2680 pid = parse_common_pid(next->data); 2705 pid = trace_parse_common_pid(next->data);
2681 field = find_field(event, "func"); 2706 field = find_field(event, "func");
2682 if (!field) 2707 if (!field)
2683 die("function return does not have field func"); 2708 die("function return does not have field func");
@@ -2963,7 +2988,7 @@ void print_event(int cpu, void *data, int size, unsigned long long nsecs,
2963 return; 2988 return;
2964 } 2989 }
2965 2990
2966 pid = parse_common_pid(data); 2991 pid = trace_parse_common_pid(data);
2967 2992
2968 if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET)) 2993 if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET))
2969 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 00000000000..51e833fd58c
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.c
@@ -0,0 +1,598 @@
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
33void xs_init(pTHX);
34
35void boot_Perf__Trace__Context(pTHX_ CV *cv);
36void boot_DynaLoader(pTHX_ CV *cv);
37
38void xs_init(pTHX)
39{
40 const char *file = __FILE__;
41 dXSUB_SYS;
42
43 newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context,
44 file);
45 newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
46}
47
48INTERP my_perl;
49
50#define FTRACE_MAX_EVENT \
51 ((1 << (sizeof(unsigned short) * 8)) - 1)
52
53struct event *events[FTRACE_MAX_EVENT];
54
55static struct scripting_context *scripting_context;
56
57static char *cur_field_name;
58static int zero_flag_atom;
59
60static void define_symbolic_value(const char *ev_name,
61 const char *field_name,
62 const char *field_value,
63 const char *field_str)
64{
65 unsigned long long value;
66 dSP;
67
68 value = eval_flag(field_value);
69
70 ENTER;
71 SAVETMPS;
72 PUSHMARK(SP);
73
74 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
75 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
76 XPUSHs(sv_2mortal(newSVuv(value)));
77 XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
78
79 PUTBACK;
80 if (get_cv("main::define_symbolic_value", 0))
81 call_pv("main::define_symbolic_value", G_SCALAR);
82 SPAGAIN;
83 PUTBACK;
84 FREETMPS;
85 LEAVE;
86}
87
88static void define_symbolic_values(struct print_flag_sym *field,
89 const char *ev_name,
90 const char *field_name)
91{
92 define_symbolic_value(ev_name, field_name, field->value, field->str);
93 if (field->next)
94 define_symbolic_values(field->next, ev_name, field_name);
95}
96
97static void define_symbolic_field(const char *ev_name,
98 const char *field_name)
99{
100 dSP;
101
102 ENTER;
103 SAVETMPS;
104 PUSHMARK(SP);
105
106 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
107 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
108
109 PUTBACK;
110 if (get_cv("main::define_symbolic_field", 0))
111 call_pv("main::define_symbolic_field", G_SCALAR);
112 SPAGAIN;
113 PUTBACK;
114 FREETMPS;
115 LEAVE;
116}
117
118static void define_flag_value(const char *ev_name,
119 const char *field_name,
120 const char *field_value,
121 const char *field_str)
122{
123 unsigned long long value;
124 dSP;
125
126 value = eval_flag(field_value);
127
128 ENTER;
129 SAVETMPS;
130 PUSHMARK(SP);
131
132 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
133 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
134 XPUSHs(sv_2mortal(newSVuv(value)));
135 XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
136
137 PUTBACK;
138 if (get_cv("main::define_flag_value", 0))
139 call_pv("main::define_flag_value", G_SCALAR);
140 SPAGAIN;
141 PUTBACK;
142 FREETMPS;
143 LEAVE;
144}
145
146static void define_flag_values(struct print_flag_sym *field,
147 const char *ev_name,
148 const char *field_name)
149{
150 define_flag_value(ev_name, field_name, field->value, field->str);
151 if (field->next)
152 define_flag_values(field->next, ev_name, field_name);
153}
154
155static void define_flag_field(const char *ev_name,
156 const char *field_name,
157 const char *delim)
158{
159 dSP;
160
161 ENTER;
162 SAVETMPS;
163 PUSHMARK(SP);
164
165 XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
166 XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
167 XPUSHs(sv_2mortal(newSVpv(delim, 0)));
168
169 PUTBACK;
170 if (get_cv("main::define_flag_field", 0))
171 call_pv("main::define_flag_field", G_SCALAR);
172 SPAGAIN;
173 PUTBACK;
174 FREETMPS;
175 LEAVE;
176}
177
178static void define_event_symbols(struct event *event,
179 const char *ev_name,
180 struct print_arg *args)
181{
182 switch (args->type) {
183 case PRINT_NULL:
184 break;
185 case PRINT_ATOM:
186 define_flag_value(ev_name, cur_field_name, "0",
187 args->atom.atom);
188 zero_flag_atom = 0;
189 break;
190 case PRINT_FIELD:
191 if (cur_field_name)
192 free(cur_field_name);
193 cur_field_name = strdup(args->field.name);
194 break;
195 case PRINT_FLAGS:
196 define_event_symbols(event, ev_name, args->flags.field);
197 define_flag_field(ev_name, cur_field_name, args->flags.delim);
198 define_flag_values(args->flags.flags, ev_name, cur_field_name);
199 break;
200 case PRINT_SYMBOL:
201 define_event_symbols(event, ev_name, args->symbol.field);
202 define_symbolic_field(ev_name, cur_field_name);
203 define_symbolic_values(args->symbol.symbols, ev_name,
204 cur_field_name);
205 break;
206 case PRINT_STRING:
207 break;
208 case PRINT_TYPE:
209 define_event_symbols(event, ev_name, args->typecast.item);
210 break;
211 case PRINT_OP:
212 if (strcmp(args->op.op, ":") == 0)
213 zero_flag_atom = 1;
214 define_event_symbols(event, ev_name, args->op.left);
215 define_event_symbols(event, ev_name, args->op.right);
216 break;
217 default:
218 /* we should warn... */
219 return;
220 }
221
222 if (args->next)
223 define_event_symbols(event, ev_name, args->next);
224}
225
226static inline struct event *find_cache_event(int type)
227{
228 static char ev_name[256];
229 struct event *event;
230
231 if (events[type])
232 return events[type];
233
234 events[type] = event = trace_find_event(type);
235 if (!event)
236 return NULL;
237
238 sprintf(ev_name, "%s::%s", event->system, event->name);
239
240 define_event_symbols(event, ev_name, event->print_fmt.args);
241
242 return event;
243}
244
245int common_pc(struct scripting_context *context)
246{
247 int pc;
248
249 pc = parse_common_pc(context->event_data);
250
251 return pc;
252}
253
254int common_flags(struct scripting_context *context)
255{
256 int flags;
257
258 flags = parse_common_flags(context->event_data);
259
260 return flags;
261}
262
263int common_lock_depth(struct scripting_context *context)
264{
265 int lock_depth;
266
267 lock_depth = parse_common_lock_depth(context->event_data);
268
269 return lock_depth;
270}
271
272static void perl_process_event(int cpu, void *data,
273 int size __attribute((unused)),
274 unsigned long long nsecs, char *comm)
275{
276 struct format_field *field;
277 static char handler[256];
278 unsigned long long val;
279 unsigned long s, ns;
280 struct event *event;
281 int type;
282 int pid;
283
284 dSP;
285
286 type = trace_parse_common_type(data);
287
288 event = find_cache_event(type);
289 if (!event)
290 die("ug! no event found for type %d", type);
291
292 pid = trace_parse_common_pid(data);
293
294 sprintf(handler, "%s::%s", event->system, event->name);
295
296 s = nsecs / NSECS_PER_SEC;
297 ns = nsecs - s * NSECS_PER_SEC;
298
299 scripting_context->event_data = data;
300
301 ENTER;
302 SAVETMPS;
303 PUSHMARK(SP);
304
305 XPUSHs(sv_2mortal(newSVpv(handler, 0)));
306 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
307 XPUSHs(sv_2mortal(newSVuv(cpu)));
308 XPUSHs(sv_2mortal(newSVuv(s)));
309 XPUSHs(sv_2mortal(newSVuv(ns)));
310 XPUSHs(sv_2mortal(newSViv(pid)));
311 XPUSHs(sv_2mortal(newSVpv(comm, 0)));
312
313 /* common fields other than pid can be accessed via xsub fns */
314
315 for (field = event->format.fields; field; field = field->next) {
316 if (field->flags & FIELD_IS_STRING) {
317 int offset;
318 if (field->flags & FIELD_IS_DYNAMIC) {
319 offset = *(int *)(data + field->offset);
320 offset &= 0xffff;
321 } else
322 offset = field->offset;
323 XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
324 } else { /* FIELD_IS_NUMERIC */
325 val = read_size(data + field->offset, field->size);
326 if (field->flags & FIELD_IS_SIGNED) {
327 XPUSHs(sv_2mortal(newSViv(val)));
328 } else {
329 XPUSHs(sv_2mortal(newSVuv(val)));
330 }
331 }
332 }
333
334 PUTBACK;
335
336 if (get_cv(handler, 0))
337 call_pv(handler, G_SCALAR);
338 else if (get_cv("main::trace_unhandled", 0)) {
339 XPUSHs(sv_2mortal(newSVpv(handler, 0)));
340 XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
341 XPUSHs(sv_2mortal(newSVuv(cpu)));
342 XPUSHs(sv_2mortal(newSVuv(nsecs)));
343 XPUSHs(sv_2mortal(newSViv(pid)));
344 XPUSHs(sv_2mortal(newSVpv(comm, 0)));
345 call_pv("main::trace_unhandled", G_SCALAR);
346 }
347 SPAGAIN;
348 PUTBACK;
349 FREETMPS;
350 LEAVE;
351}
352
353static void run_start_sub(void)
354{
355 dSP; /* access to Perl stack */
356 PUSHMARK(SP);
357
358 if (get_cv("main::trace_begin", 0))
359 call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
360}
361
362/*
363 * Start trace script
364 */
365static int perl_start_script(const char *script)
366{
367 const char *command_line[2] = { "", NULL };
368
369 command_line[1] = script;
370
371 my_perl = perl_alloc();
372 perl_construct(my_perl);
373
374 if (perl_parse(my_perl, xs_init, 2, (char **)command_line,
375 (char **)NULL))
376 return -1;
377
378 perl_run(my_perl);
379 if (SvTRUE(ERRSV))
380 return -1;
381
382 run_start_sub();
383
384 fprintf(stderr, "perf trace started with Perl script %s\n\n", script);
385
386 return 0;
387}
388
389/*
390 * Stop trace script
391 */
392static int perl_stop_script(void)
393{
394 dSP; /* access to Perl stack */
395 PUSHMARK(SP);
396
397 if (get_cv("main::trace_end", 0))
398 call_pv("main::trace_end", G_DISCARD | G_NOARGS);
399
400 perl_destruct(my_perl);
401 perl_free(my_perl);
402
403 fprintf(stderr, "\nperf trace Perl script stopped\n");
404
405 return 0;
406}
407
408static int perl_generate_script(const char *outfile)
409{
410 struct event *event = NULL;
411 struct format_field *f;
412 char fname[PATH_MAX];
413 int not_first, count;
414 FILE *ofp;
415
416 sprintf(fname, "%s.pl", outfile);
417 ofp = fopen(fname, "w");
418 if (ofp == NULL) {
419 fprintf(stderr, "couldn't open %s\n", fname);
420 return -1;
421 }
422
423 fprintf(ofp, "# perf trace event handlers, "
424 "generated by perf trace -g perl\n");
425
426 fprintf(ofp, "# Licensed under the terms of the GNU GPL"
427 " License version 2\n\n");
428
429 fprintf(ofp, "# The common_* event handler fields are the most useful "
430 "fields common to\n");
431
432 fprintf(ofp, "# all events. They don't necessarily correspond to "
433 "the 'common_*' fields\n");
434
435 fprintf(ofp, "# in the format files. Those fields not available as "
436 "handler params can\n");
437
438 fprintf(ofp, "# be retrieved using Perl functions of the form "
439 "common_*($context).\n");
440
441 fprintf(ofp, "# See Context.pm for the list of available "
442 "functions.\n\n");
443
444 fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
445 "Perf-Trace-Util/lib\";\n");
446
447 fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
448 fprintf(ofp, "use Perf::Trace::Core;\n");
449 fprintf(ofp, "use Perf::Trace::Context;\n");
450 fprintf(ofp, "use Perf::Trace::Util;\n\n");
451
452 fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
453 fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n");
454
455 while ((event = trace_find_next_event(event))) {
456 fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
457 fprintf(ofp, "\tmy (");
458
459 fprintf(ofp, "$event_name, ");
460 fprintf(ofp, "$context, ");
461 fprintf(ofp, "$common_cpu, ");
462 fprintf(ofp, "$common_secs, ");
463 fprintf(ofp, "$common_nsecs,\n");
464 fprintf(ofp, "\t $common_pid, ");
465 fprintf(ofp, "$common_comm,\n\t ");
466
467 not_first = 0;
468 count = 0;
469
470 for (f = event->format.fields; f; f = f->next) {
471 if (not_first++)
472 fprintf(ofp, ", ");
473 if (++count % 5 == 0)
474 fprintf(ofp, "\n\t ");
475
476 fprintf(ofp, "$%s", f->name);
477 }
478 fprintf(ofp, ") = @_;\n\n");
479
480 fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
481 "$common_secs, $common_nsecs,\n\t "
482 "$common_pid, $common_comm);\n\n");
483
484 fprintf(ofp, "\tprintf(\"");
485
486 not_first = 0;
487 count = 0;
488
489 for (f = event->format.fields; f; f = f->next) {
490 if (not_first++)
491 fprintf(ofp, ", ");
492 if (count && count % 4 == 0) {
493 fprintf(ofp, "\".\n\t \"");
494 }
495 count++;
496
497 fprintf(ofp, "%s=", f->name);
498 if (f->flags & FIELD_IS_STRING ||
499 f->flags & FIELD_IS_FLAG ||
500 f->flags & FIELD_IS_SYMBOLIC)
501 fprintf(ofp, "%%s");
502 else if (f->flags & FIELD_IS_SIGNED)
503 fprintf(ofp, "%%d");
504 else
505 fprintf(ofp, "%%u");
506 }
507
508 fprintf(ofp, "\\n\",\n\t ");
509
510 not_first = 0;
511 count = 0;
512
513 for (f = event->format.fields; f; f = f->next) {
514 if (not_first++)
515 fprintf(ofp, ", ");
516
517 if (++count % 5 == 0)
518 fprintf(ofp, "\n\t ");
519
520 if (f->flags & FIELD_IS_FLAG) {
521 if ((count - 1) % 5 != 0) {
522 fprintf(ofp, "\n\t ");
523 count = 4;
524 }
525 fprintf(ofp, "flag_str(\"");
526 fprintf(ofp, "%s::%s\", ", event->system,
527 event->name);
528 fprintf(ofp, "\"%s\", $%s)", f->name,
529 f->name);
530 } else if (f->flags & FIELD_IS_SYMBOLIC) {
531 if ((count - 1) % 5 != 0) {
532 fprintf(ofp, "\n\t ");
533 count = 4;
534 }
535 fprintf(ofp, "symbol_str(\"");
536 fprintf(ofp, "%s::%s\", ", event->system,
537 event->name);
538 fprintf(ofp, "\"%s\", $%s)", f->name,
539 f->name);
540 } else
541 fprintf(ofp, "$%s", f->name);
542 }
543
544 fprintf(ofp, ");\n");
545 fprintf(ofp, "}\n\n");
546 }
547
548 fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
549 "$common_cpu, $common_secs, $common_nsecs,\n\t "
550 "$common_pid, $common_comm) = @_;\n\n");
551
552 fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
553 "$common_secs, $common_nsecs,\n\t $common_pid, "
554 "$common_comm);\n}\n\n");
555
556 fprintf(ofp, "sub print_header\n{\n"
557 "\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
558 "\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t "
559 "$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}");
560
561 fclose(ofp);
562
563 fprintf(stderr, "generated Perl script: %s\n", fname);
564
565 return 0;
566}
567
568struct scripting_ops perl_scripting_ops = {
569 .name = "Perl",
570 .start_script = perl_start_script,
571 .stop_script = perl_stop_script,
572 .process_event = perl_process_event,
573 .generate_script = perl_generate_script,
574};
575
576#ifdef NO_LIBPERL
577void setup_perl_scripting(void)
578{
579 fprintf(stderr, "Perl scripting not supported."
580 " Install libperl and rebuild perf to enable it. e.g. "
581 "apt-get install libperl-dev (ubuntu), yum install "
582 "perl-ExtUtils-Embed (Fedora), etc.\n");
583}
584#else
585void setup_perl_scripting(void)
586{
587 int err;
588 err = script_spec_register("Perl", &perl_scripting_ops);
589 if (err)
590 die("error registering Perl script extension");
591
592 err = script_spec_register("pl", &perl_scripting_ops);
593 if (err)
594 die("error registering pl script extension");
595
596 scripting_context = malloc(sizeof(struct scripting_context));
597}
598#endif
diff --git a/tools/perf/util/trace-event-perl.h b/tools/perf/util/trace-event-perl.h
new file mode 100644
index 00000000000..8fe0d866fe1
--- /dev/null
+++ b/tools/perf/util/trace-event-perl.h
@@ -0,0 +1,51 @@
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#define pTHX void
33#define CV void
34#define dXSUB_SYS
35#define pTHX_
36static inline void newXS(const char *a, void *b, const char *c) {}
37#else
38#include <EXTERN.h>
39#include <perl.h>
40typedef PerlInterpreter * INTERP;
41#endif
42
43struct scripting_context {
44 void *event_data;
45};
46
47int common_pc(struct scripting_context *context);
48int common_flags(struct scripting_context *context);
49int common_lock_depth(struct scripting_context *context);
50
51#endif /* __PERF_TRACE_EVENT_PERL_H */
diff --git a/tools/perf/util/trace-event.h b/tools/perf/util/trace-event.h
index dd51c6872a1..81698d5e650 100644
--- a/tools/perf/util/trace-event.h
+++ b/tools/perf/util/trace-event.h
@@ -29,6 +29,8 @@ enum format_flags {
29 FIELD_IS_SIGNED = 4, 29 FIELD_IS_SIGNED = 4,
30 FIELD_IS_STRING = 8, 30 FIELD_IS_STRING = 8,
31 FIELD_IS_DYNAMIC = 16, 31 FIELD_IS_DYNAMIC = 16,
32 FIELD_IS_FLAG = 32,
33 FIELD_IS_SYMBOLIC = 64,
32}; 34};
33 35
34struct format_field { 36struct format_field {
@@ -243,10 +245,17 @@ extern int latency_format;
243 245
244int parse_header_page(char *buf, unsigned long size); 246int parse_header_page(char *buf, unsigned long size);
245int trace_parse_common_type(void *data); 247int trace_parse_common_type(void *data);
248int trace_parse_common_pid(void *data);
249int parse_common_pc(void *data);
250int parse_common_flags(void *data);
251int parse_common_lock_depth(void *data);
246struct event *trace_find_event(int id); 252struct event *trace_find_event(int id);
253struct event *trace_find_next_event(struct event *event);
254unsigned long long read_size(void *ptr, int size);
247unsigned long long 255unsigned long long
248raw_field_value(struct event *event, const char *name, void *data); 256raw_field_value(struct event *event, const char *name, void *data);
249void *raw_field_ptr(struct event *event, const char *name, void *data); 257void *raw_field_ptr(struct event *event, const char *name, void *data);
258unsigned long long eval_flag(const char *flag);
250 259
251int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events); 260int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events);
252 261
@@ -259,4 +268,18 @@ enum trace_flag_type {
259 TRACE_FLAG_SOFTIRQ = 0x10, 268 TRACE_FLAG_SOFTIRQ = 0x10,
260}; 269};
261 270
271struct scripting_ops {
272 const char *name;
273 int (*start_script) (const char *);
274 int (*stop_script) (void);
275 void (*process_event) (int cpu, void *data, int size,
276 unsigned long long nsecs, char *comm);
277 int (*generate_script) (const char *outfile);
278};
279
280int script_spec_register(const char *spec, struct scripting_ops *ops);
281
282extern struct scripting_ops perl_scripting_ops;
283void setup_perl_scripting(void);
284
262#endif /* __PERF_TRACE_EVENTS_H */ 285#endif /* __PERF_TRACE_EVENTS_H */
generated by cgit v1.2.2 (git 2.25.0) at 2024-12-23 08:36:55 -0500