mirror of https://gitee.com/openkylin/linux.git
Merge branch 'perf/scripting' into perf/core
Merge reason: it's ready for v2.6.33. Signed-off-by: Ingo Molnar <mingo@elte.hu>
This commit is contained in:
Ingo Molnar
commit
23ba90e328
|
|
@ -0,0 +1,219 @@
|
|||
perf-trace-perl(1)
|
||||
==================
|
||||
|
||||
NAME
|
||||
----
|
||||
perf-trace-perl - Process trace data with a Perl script
|
||||
|
||||
SYNOPSIS
|
||||
--------
|
||||
[verse]
|
||||
'perf trace' [-s [lang]:script[.ext] ]
|
||||
|
||||
DESCRIPTION
|
||||
-----------
|
||||
|
||||
This perf trace option is used to process perf trace data using perf's
|
||||
built-in Perl interpreter. It reads and processes the input file and
|
||||
displays the results of the trace analysis implemented in the given
|
||||
Perl script, if any.
|
||||
|
||||
STARTER SCRIPTS
|
||||
---------------
|
||||
|
||||
You can avoid reading the rest of this document by running 'perf trace
|
||||
-g perl' in the same directory as an existing perf.data trace file.
|
||||
That will generate a starter script containing a handler for each of
|
||||
the event types in the trace file; it simply prints every available
|
||||
field for each event in the trace file.
|
||||
|
||||
You can also look at the existing scripts in
|
||||
~/libexec/perf-core/scripts/perl for typical examples showing how to
|
||||
do basic things like aggregate event data, print results, etc. Also,
|
||||
the check-perf-trace.pl script, while not interesting for its results,
|
||||
attempts to exercise all of the main scripting features.
|
||||
|
||||
EVENT HANDLERS
|
||||
--------------
|
||||
|
||||
When perf trace is invoked using a trace script, a user-defined
|
||||
'handler function' is called for each event in the trace. If there's
|
||||
no handler function defined for a given event type, the event is
|
||||
ignored (or passed to a 'trace_handled' function, see below) and the
|
||||
next event is processed.
|
||||
|
||||
Most of the event's field values are passed as arguments to the
|
||||
handler function; some of the less common ones aren't - those are
|
||||
available as calls back into the perf executable (see below).
|
||||
|
||||
As an example, the following perf record command can be used to record
|
||||
all sched_wakeup events in the system:
|
||||
|
||||
# perf record -c 1 -f -a -M -R -e sched:sched_wakeup
|
||||
|
||||
Traces meant to be processed using a script should be recorded with
|
||||
the above options: -c 1 says to sample every event, -a to enable
|
||||
system-wide collection, -M to multiplex the output, and -R to collect
|
||||
raw samples.
|
||||
|
||||
The format file for the sched_wakep event defines the following fields
|
||||
(see /sys/kernel/debug/tracing/events/sched/sched_wakeup/format):
|
||||
|
||||
----
|
||||
format:
|
||||
field:unsigned short common_type;
|
||||
field:unsigned char common_flags;
|
||||
field:unsigned char common_preempt_count;
|
||||
field:int common_pid;
|
||||
field:int common_lock_depth;
|
||||
|
||||
field:char comm[TASK_COMM_LEN];
|
||||
field:pid_t pid;
|
||||
field:int prio;
|
||||
field:int success;
|
||||
field:int target_cpu;
|
||||
----
|
||||
|
||||
The handler function for this event would be defined as:
|
||||
|
||||
----
|
||||
sub sched::sched_wakeup
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs,
|
||||
$common_nsecs, $common_pid, $common_comm,
|
||||
$comm, $pid, $prio, $success, $target_cpu) = @_;
|
||||
}
|
||||
----
|
||||
|
||||
The handler function takes the form subsystem::event_name.
|
||||
|
||||
The $common_* arguments in the handler's argument list are the set of
|
||||
arguments passed to all event handlers; some of the fields correspond
|
||||
to the common_* fields in the format file, but some are synthesized,
|
||||
and some of the common_* fields aren't common enough to to be passed
|
||||
to every event as arguments but are available as library functions.
|
||||
|
||||
Here's a brief description of each of the invariant event args:
|
||||
|
||||
$event_name the name of the event as text
|
||||
$context an opaque 'cookie' used in calls back into perf
|
||||
$common_cpu the cpu the event occurred on
|
||||
$common_secs the secs portion of the event timestamp
|
||||
$common_nsecs the nsecs portion of the event timestamp
|
||||
$common_pid the pid of the current task
|
||||
$common_comm the name of the current process
|
||||
|
||||
All of the remaining fields in the event's format file have
|
||||
counterparts as handler function arguments of the same name, as can be
|
||||
seen in the example above.
|
||||
|
||||
The above provides the basics needed to directly access every field of
|
||||
every event in a trace, which covers 90% of what you need to know to
|
||||
write a useful trace script. The sections below cover the rest.
|
||||
|
||||
SCRIPT LAYOUT
|
||||
-------------
|
||||
|
||||
Every perf trace Perl script should start by setting up a Perl module
|
||||
search path and 'use'ing a few support modules (see module
|
||||
descriptions below):
|
||||
|
||||
----
|
||||
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
|
||||
use lib "./Perf-Trace-Util/lib";
|
||||
use Perf::Trace::Core;
|
||||
use Perf::Trace::Context;
|
||||
use Perf::Trace::Util;
|
||||
----
|
||||
|
||||
The rest of the script can contain handler functions and support
|
||||
functions in any order.
|
||||
|
||||
Aside from the event handler functions discussed above, every script
|
||||
can implement a set of optional functions:
|
||||
|
||||
*trace_begin*, if defined, is called before any event is processed and
|
||||
gives scripts a chance to do setup tasks:
|
||||
|
||||
----
|
||||
sub trace_begin
|
||||
{
|
||||
}
|
||||
----
|
||||
|
||||
*trace_end*, if defined, is called after all events have been
|
||||
processed and gives scripts a chance to do end-of-script tasks, such
|
||||
as display results:
|
||||
|
||||
----
|
||||
sub trace_end
|
||||
{
|
||||
}
|
||||
----
|
||||
|
||||
*trace_unhandled*, if defined, is called after for any event that
|
||||
doesn't have a handler explicitly defined for it. The standard set
|
||||
of common arguments are passed into it:
|
||||
|
||||
----
|
||||
sub trace_unhandled
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs,
|
||||
$common_nsecs, $common_pid, $common_comm) = @_;
|
||||
}
|
||||
----
|
||||
|
||||
The remaining sections provide descriptions of each of the available
|
||||
built-in perf trace Perl modules and their associated functions.
|
||||
|
||||
AVAILABLE MODULES AND FUNCTIONS
|
||||
-------------------------------
|
||||
|
||||
The following sections describe the functions and variables available
|
||||
via the various Perf::Trace::* Perl modules. To use the functions and
|
||||
variables from the given module, add the corresponding 'use
|
||||
Perf::Trace::XXX' line to your perf trace script.
|
||||
|
||||
Perf::Trace::Core Module
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
These functions provide some essential functions to user scripts.
|
||||
|
||||
The *flag_str* and *symbol_str* functions provide human-readable
|
||||
strings for flag and symbolic fields. These correspond to the strings
|
||||
and values parsed from the 'print fmt' fields of the event format
|
||||
files:
|
||||
|
||||
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
|
||||
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
|
||||
|
||||
Perf::Trace::Context Module
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Some of the 'common' fields in the event format file aren't all that
|
||||
common, but need to be made accessible to user scripts nonetheless.
|
||||
|
||||
Perf::Trace::Context defines a set of functions that can be used to
|
||||
access this data in the context of the current event. Each of these
|
||||
functions expects a $context variable, which is the same as the
|
||||
$context variable passed into every event handler as the second
|
||||
argument.
|
||||
|
||||
common_pc($context) - returns common_preempt count for the current event
|
||||
common_flags($context) - returns common_flags for the current event
|
||||
common_lock_depth($context) - returns common_lock_depth for the current event
|
||||
|
||||
Perf::Trace::Util Module
|
||||
~~~~~~~~~~~~~~~~~~~~~~~~
|
||||
|
||||
Various utility functions for use with perf trace:
|
||||
|
||||
nsecs($secs, $nsecs) - returns total nsecs given secs/nsecs pair
|
||||
nsecs_secs($nsecs) - returns whole secs portion given nsecs
|
||||
nsecs_nsecs($nsecs) - returns nsecs remainder given nsecs
|
||||
nsecs_str($nsecs) - returns printable string in the form secs.nsecs
|
||||
avg($total, $n) - returns average given a sum and a total number of values
|
||||
|
||||
SEE ALSO
|
||||
--------
|
||||
linkperf:perf-trace[1]
|
||||
|
|
@ -20,6 +20,15 @@ OPTIONS
|
|||
--dump-raw-trace=::
|
||||
Display verbose dump of the trace data.
|
||||
|
||||
-s::
|
||||
--script=::
|
||||
Process trace data with the given script ([lang]:script[.ext]).
|
||||
|
||||
-g::
|
||||
--gen-script=::
|
||||
Generate perf-trace.[ext] starter script for given language,
|
||||
using current perf.data.
|
||||
|
||||
SEE ALSO
|
||||
--------
|
||||
linkperf:perf-record[1]
|
||||
linkperf:perf-record[1], linkperf:perf-trace-perl[1]
|
||||
|
|
|
|||
|
|
@ -409,6 +409,7 @@ LIB_OBJS += util/thread.o
|
|||
LIB_OBJS += util/trace-event-parse.o
|
||||
LIB_OBJS += util/trace-event-read.o
|
||||
LIB_OBJS += util/trace-event-info.o
|
||||
LIB_OBJS += util/trace-event-perl.o
|
||||
LIB_OBJS += util/svghelper.o
|
||||
LIB_OBJS += util/sort.o
|
||||
LIB_OBJS += util/hist.o
|
||||
|
|
@ -491,6 +492,16 @@ else
|
|||
LIB_OBJS += util/probe-finder.o
|
||||
endif
|
||||
|
||||
PERL_EMBED_LDOPTS = `perl -MExtUtils::Embed -e ldopts 2>/dev/null`
|
||||
PERL_EMBED_CCOPTS = `perl -MExtUtils::Embed -e ccopts 2>/dev/null`
|
||||
|
||||
ifneq ($(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)
|
||||
BASIC_CFLAGS += -DNO_LIBPERL
|
||||
else
|
||||
ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)
|
||||
LIB_OBJS += scripts/perl/Perf-Trace-Util/Context.o
|
||||
endif
|
||||
|
||||
ifdef NO_DEMANGLE
|
||||
BASIC_CFLAGS += -DNO_DEMANGLE
|
||||
else
|
||||
|
|
@ -862,6 +873,12 @@ util/hweight.o: ../../lib/hweight.c PERF-CFLAGS
|
|||
util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS
|
||||
$(QUIET_CC)$(CC) -o util/find_next_bit.o -c $(ALL_CFLAGS) -DETC_PERFCONFIG='"$(ETC_PERFCONFIG_SQ)"' $<
|
||||
|
||||
util/trace-event-perl.o: util/trace-event-perl.c PERF-CFLAGS
|
||||
$(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 $<
|
||||
|
||||
scripts/perl/Perf-Trace-Util/Context.o: scripts/perl/Perf-Trace-Util/Context.c PERF-CFLAGS
|
||||
$(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 $<
|
||||
|
||||
perf-%$X: %.o $(PERFLIBS)
|
||||
$(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
|
||||
|
||||
|
|
@ -969,6 +986,13 @@ export perfexec_instdir
|
|||
install: all
|
||||
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'
|
||||
$(INSTALL) perf$X '$(DESTDIR_SQ)$(bindir_SQ)'
|
||||
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
|
||||
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
|
||||
$(INSTALL) scripts/perl/Perf-Trace-Util/lib/Perf/Trace/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util/lib/Perf/Trace'
|
||||
$(INSTALL) scripts/perl/*.pl -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl'
|
||||
$(INSTALL) scripts/perl/bin/* -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/bin'
|
||||
$(INSTALL) scripts/perl/Perf-Trace-Util/Makefile.PL -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
|
||||
$(INSTALL) scripts/perl/Perf-Trace-Util/README -t '$(DESTDIR_SQ)$(perfexec_instdir_SQ)/scripts/perl/Perf-Trace-Util'
|
||||
ifdef BUILT_INS
|
||||
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
|
||||
$(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
|
||||
|
|
@ -1054,7 +1078,7 @@ distclean: clean
|
|||
# $(RM) configure
|
||||
|
||||
clean:
|
||||
$(RM) *.o */*.o $(LIB_FILE)
|
||||
$(RM) *.o */*.o */*/*.o */*/*/*.o $(LIB_FILE)
|
||||
$(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X
|
||||
$(RM) $(TEST_PROGRAMS)
|
||||
$(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope*
|
||||
|
|
|
|||
|
|
@ -5,6 +5,50 @@
|
|||
#include "util/symbol.h"
|
||||
#include "util/thread.h"
|
||||
#include "util/header.h"
|
||||
#include "util/exec_cmd.h"
|
||||
#include "util/trace-event.h"
|
||||
|
||||
static char const *script_name;
|
||||
static char const *generate_script_lang;
|
||||
|
||||
static int default_start_script(const char *script __attribute((unused)))
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int default_stop_script(void)
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int default_generate_script(const char *outfile __attribute ((unused)))
|
||||
{
|
||||
return 0;
|
||||
}
|
||||
|
||||
static struct scripting_ops default_scripting_ops = {
|
||||
.start_script = default_start_script,
|
||||
.stop_script = default_stop_script,
|
||||
.process_event = print_event,
|
||||
.generate_script = default_generate_script,
|
||||
};
|
||||
|
||||
static struct scripting_ops *scripting_ops;
|
||||
|
||||
static void setup_scripting(void)
|
||||
{
|
||||
/* make sure PERF_EXEC_PATH is set for scripts */
|
||||
perf_set_argv_exec_path(perf_exec_path());
|
||||
|
||||
setup_perl_scripting();
|
||||
|
||||
scripting_ops = &default_scripting_ops;
|
||||
}
|
||||
|
||||
static int cleanup_scripting(void)
|
||||
{
|
||||
return scripting_ops->stop_script();
|
||||
}
|
||||
|
||||
#include "util/parse-options.h"
|
||||
|
||||
|
|
@ -13,11 +57,12 @@
|
|||
|
||||
#include "util/trace-event.h"
|
||||
#include "util/data_map.h"
|
||||
#include "util/exec_cmd.h"
|
||||
|
||||
static char const *input_name = "perf.data";
|
||||
static char const *input_name = "perf.data";
|
||||
|
||||
static struct perf_header *header;
|
||||
static u64 sample_type;
|
||||
static struct perf_header *header;
|
||||
static u64 sample_type;
|
||||
|
||||
static int process_sample_event(event_t *event)
|
||||
{
|
||||
|
|
@ -69,7 +114,8 @@ static int process_sample_event(event_t *event)
|
|||
* field, although it should be the same than this perf
|
||||
* event pid
|
||||
*/
|
||||
print_event(cpu, raw->data, raw->size, timestamp, thread->comm);
|
||||
scripting_ops->process_event(cpu, raw->data, raw->size,
|
||||
timestamp, thread->comm);
|
||||
}
|
||||
event__stats.total += period;
|
||||
|
||||
|
|
@ -105,6 +151,154 @@ static int __cmd_trace(void)
|
|||
0, 0, &event__cwdlen, &event__cwd);
|
||||
}
|
||||
|
||||
struct script_spec {
|
||||
struct list_head node;
|
||||
struct scripting_ops *ops;
|
||||
char spec[0];
|
||||
};
|
||||
|
||||
LIST_HEAD(script_specs);
|
||||
|
||||
static struct script_spec *script_spec__new(const char *spec,
|
||||
struct scripting_ops *ops)
|
||||
{
|
||||
struct script_spec *s = malloc(sizeof(*s) + strlen(spec) + 1);
|
||||
|
||||
if (s != NULL) {
|
||||
strcpy(s->spec, spec);
|
||||
s->ops = ops;
|
||||
}
|
||||
|
||||
return s;
|
||||
}
|
||||
|
||||
static void script_spec__delete(struct script_spec *s)
|
||||
{
|
||||
free(s->spec);
|
||||
free(s);
|
||||
}
|
||||
|
||||
static void script_spec__add(struct script_spec *s)
|
||||
{
|
||||
list_add_tail(&s->node, &script_specs);
|
||||
}
|
||||
|
||||
static struct script_spec *script_spec__find(const char *spec)
|
||||
{
|
||||
struct script_spec *s;
|
||||
|
||||
list_for_each_entry(s, &script_specs, node)
|
||||
if (strcasecmp(s->spec, spec) == 0)
|
||||
return s;
|
||||
return NULL;
|
||||
}
|
||||
|
||||
static struct script_spec *script_spec__findnew(const char *spec,
|
||||
struct scripting_ops *ops)
|
||||
{
|
||||
struct script_spec *s = script_spec__find(spec);
|
||||
|
||||
if (s)
|
||||
return s;
|
||||
|
||||
s = script_spec__new(spec, ops);
|
||||
if (!s)
|
||||
goto out_delete_spec;
|
||||
|
||||
script_spec__add(s);
|
||||
|
||||
return s;
|
||||
|
||||
out_delete_spec:
|
||||
script_spec__delete(s);
|
||||
|
||||
return NULL;
|
||||
}
|
||||
|
||||
int script_spec_register(const char *spec, struct scripting_ops *ops)
|
||||
{
|
||||
struct script_spec *s;
|
||||
|
||||
s = script_spec__find(spec);
|
||||
if (s)
|
||||
return -1;
|
||||
|
||||
s = script_spec__findnew(spec, ops);
|
||||
if (!s)
|
||||
return -1;
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static struct scripting_ops *script_spec__lookup(const char *spec)
|
||||
{
|
||||
struct script_spec *s = script_spec__find(spec);
|
||||
if (!s)
|
||||
return NULL;
|
||||
|
||||
return s->ops;
|
||||
}
|
||||
|
||||
static void list_available_languages(void)
|
||||
{
|
||||
struct script_spec *s;
|
||||
|
||||
fprintf(stderr, "\n");
|
||||
fprintf(stderr, "Scripting language extensions (used in "
|
||||
"perf trace -s [spec:]script.[spec]):\n\n");
|
||||
|
||||
list_for_each_entry(s, &script_specs, node)
|
||||
fprintf(stderr, " %-42s [%s]\n", s->spec, s->ops->name);
|
||||
|
||||
fprintf(stderr, "\n");
|
||||
}
|
||||
|
||||
static int parse_scriptname(const struct option *opt __used,
|
||||
const char *str, int unset __used)
|
||||
{
|
||||
char spec[PATH_MAX];
|
||||
const char *script, *ext;
|
||||
int len;
|
||||
|
||||
if (strcmp(str, "list") == 0) {
|
||||
list_available_languages();
|
||||
return 0;
|
||||
}
|
||||
|
||||
script = strchr(str, ':');
|
||||
if (script) {
|
||||
len = script - str;
|
||||
if (len >= PATH_MAX) {
|
||||
fprintf(stderr, "invalid language specifier");
|
||||
return -1;
|
||||
}
|
||||
strncpy(spec, str, len);
|
||||
spec[len] = '\0';
|
||||
scripting_ops = script_spec__lookup(spec);
|
||||
if (!scripting_ops) {
|
||||
fprintf(stderr, "invalid language specifier");
|
||||
return -1;
|
||||
}
|
||||
script++;
|
||||
} else {
|
||||
script = str;
|
||||
ext = strchr(script, '.');
|
||||
if (!ext) {
|
||||
fprintf(stderr, "invalid script extension");
|
||||
return -1;
|
||||
}
|
||||
scripting_ops = script_spec__lookup(++ext);
|
||||
if (!scripting_ops) {
|
||||
fprintf(stderr, "invalid script extension");
|
||||
return -1;
|
||||
}
|
||||
}
|
||||
|
||||
script_name = strdup(script);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static const char * const annotate_usage[] = {
|
||||
"perf trace [<options>] <command>",
|
||||
NULL
|
||||
|
|
@ -117,13 +311,23 @@ static const struct option options[] = {
|
|||
"be more verbose (show symbol address, etc)"),
|
||||
OPT_BOOLEAN('l', "latency", &latency_format,
|
||||
"show latency attributes (irqs/preemption disabled, etc)"),
|
||||
OPT_CALLBACK('s', "script", NULL, "name",
|
||||
"script file name (lang:script name, script name, or *)",
|
||||
parse_scriptname),
|
||||
OPT_STRING('g', "gen-script", &generate_script_lang, "lang",
|
||||
"generate perf-trace.xx script in specified language"),
|
||||
|
||||
OPT_END()
|
||||
};
|
||||
|
||||
int cmd_trace(int argc, const char **argv, const char *prefix __used)
|
||||
{
|
||||
int err;
|
||||
|
||||
symbol__init(0);
|
||||
|
||||
setup_scripting();
|
||||
|
||||
argc = parse_options(argc, argv, options, annotate_usage, 0);
|
||||
if (argc) {
|
||||
/*
|
||||
|
|
@ -136,5 +340,50 @@ int cmd_trace(int argc, const char **argv, const char *prefix __used)
|
|||
|
||||
setup_pager();
|
||||
|
||||
return __cmd_trace();
|
||||
if (generate_script_lang) {
|
||||
struct stat perf_stat;
|
||||
|
||||
int input = open(input_name, O_RDONLY);
|
||||
if (input < 0) {
|
||||
perror("failed to open file");
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
err = fstat(input, &perf_stat);
|
||||
if (err < 0) {
|
||||
perror("failed to stat file");
|
||||
exit(-1);
|
||||
}
|
||||
|
||||
if (!perf_stat.st_size) {
|
||||
fprintf(stderr, "zero-sized file, nothing to do!\n");
|
||||
exit(0);
|
||||
}
|
||||
|
||||
scripting_ops = script_spec__lookup(generate_script_lang);
|
||||
if (!scripting_ops) {
|
||||
fprintf(stderr, "invalid language specifier");
|
||||
return -1;
|
||||
}
|
||||
|
||||
header = perf_header__new();
|
||||
if (header == NULL)
|
||||
return -1;
|
||||
|
||||
perf_header__read(header, input);
|
||||
err = scripting_ops->generate_script("perf-trace");
|
||||
goto out;
|
||||
}
|
||||
|
||||
if (script_name) {
|
||||
err = scripting_ops->start_script(script_name);
|
||||
if (err)
|
||||
goto out;
|
||||
}
|
||||
|
||||
err = __cmd_trace();
|
||||
|
||||
cleanup_scripting();
|
||||
out:
|
||||
return err;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -0,0 +1,134 @@
|
|||
/*
|
||||
* This file was generated automatically by ExtUtils::ParseXS version 2.18_02 from the
|
||||
* contents of Context.xs. Do not edit this file, edit Context.xs instead.
|
||||
*
|
||||
* ANY CHANGES MADE HERE WILL BE LOST!
|
||||
*
|
||||
*/
|
||||
|
||||
#line 1 "Context.xs"
|
||||
/*
|
||||
* Context.xs. XS interfaces for perf trace.
|
||||
*
|
||||
* Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program; if not, write to the Free Software
|
||||
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*
|
||||
*/
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#include "../../../util/trace-event-perl.h"
|
||||
|
||||
#ifndef PERL_UNUSED_VAR
|
||||
# define PERL_UNUSED_VAR(var) if (0) var = var
|
||||
#endif
|
||||
|
||||
#line 41 "Context.c"
|
||||
|
||||
XS(XS_Perf__Trace__Context_common_pc); /* prototype to pass -Wmissing-prototypes */
|
||||
XS(XS_Perf__Trace__Context_common_pc)
|
||||
{
|
||||
#ifdef dVAR
|
||||
dVAR; dXSARGS;
|
||||
#else
|
||||
dXSARGS;
|
||||
#endif
|
||||
if (items != 1)
|
||||
Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_pc", "context");
|
||||
PERL_UNUSED_VAR(cv); /* -W */
|
||||
{
|
||||
struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
|
||||
int RETVAL;
|
||||
dXSTARG;
|
||||
|
||||
RETVAL = common_pc(context);
|
||||
XSprePUSH; PUSHi((IV)RETVAL);
|
||||
}
|
||||
XSRETURN(1);
|
||||
}
|
||||
|
||||
|
||||
XS(XS_Perf__Trace__Context_common_flags); /* prototype to pass -Wmissing-prototypes */
|
||||
XS(XS_Perf__Trace__Context_common_flags)
|
||||
{
|
||||
#ifdef dVAR
|
||||
dVAR; dXSARGS;
|
||||
#else
|
||||
dXSARGS;
|
||||
#endif
|
||||
if (items != 1)
|
||||
Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_flags", "context");
|
||||
PERL_UNUSED_VAR(cv); /* -W */
|
||||
{
|
||||
struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
|
||||
int RETVAL;
|
||||
dXSTARG;
|
||||
|
||||
RETVAL = common_flags(context);
|
||||
XSprePUSH; PUSHi((IV)RETVAL);
|
||||
}
|
||||
XSRETURN(1);
|
||||
}
|
||||
|
||||
|
||||
XS(XS_Perf__Trace__Context_common_lock_depth); /* prototype to pass -Wmissing-prototypes */
|
||||
XS(XS_Perf__Trace__Context_common_lock_depth)
|
||||
{
|
||||
#ifdef dVAR
|
||||
dVAR; dXSARGS;
|
||||
#else
|
||||
dXSARGS;
|
||||
#endif
|
||||
if (items != 1)
|
||||
Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::common_lock_depth", "context");
|
||||
PERL_UNUSED_VAR(cv); /* -W */
|
||||
{
|
||||
struct scripting_context * context = INT2PTR(struct scripting_context *,SvIV(ST(0)));
|
||||
int RETVAL;
|
||||
dXSTARG;
|
||||
|
||||
RETVAL = common_lock_depth(context);
|
||||
XSprePUSH; PUSHi((IV)RETVAL);
|
||||
}
|
||||
XSRETURN(1);
|
||||
}
|
||||
|
||||
#ifdef __cplusplus
|
||||
extern "C"
|
||||
#endif
|
||||
XS(boot_Perf__Trace__Context); /* prototype to pass -Wmissing-prototypes */
|
||||
XS(boot_Perf__Trace__Context)
|
||||
{
|
||||
#ifdef dVAR
|
||||
dVAR; dXSARGS;
|
||||
#else
|
||||
dXSARGS;
|
||||
#endif
|
||||
const char* file = __FILE__;
|
||||
|
||||
PERL_UNUSED_VAR(cv); /* -W */
|
||||
PERL_UNUSED_VAR(items); /* -W */
|
||||
XS_VERSION_BOOTCHECK ;
|
||||
|
||||
newXSproto("Perf::Trace::Context::common_pc", XS_Perf__Trace__Context_common_pc, file, "$");
|
||||
newXSproto("Perf::Trace::Context::common_flags", XS_Perf__Trace__Context_common_flags, file, "$");
|
||||
newXSproto("Perf::Trace::Context::common_lock_depth", XS_Perf__Trace__Context_common_lock_depth, file, "$");
|
||||
if (PL_unitcheckav)
|
||||
call_list(PL_scopestack_ix, PL_unitcheckav);
|
||||
XSRETURN_YES;
|
||||
}
|
||||
|
||||
|
|
@ -0,0 +1,41 @@
|
|||
/*
|
||||
* Context.xs. XS interfaces for perf trace.
|
||||
*
|
||||
* Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program; if not, write to the Free Software
|
||||
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*
|
||||
*/
|
||||
|
||||
#include "EXTERN.h"
|
||||
#include "perl.h"
|
||||
#include "XSUB.h"
|
||||
#include "../../../util/trace-event-perl.h"
|
||||
|
||||
MODULE = Perf::Trace::Context PACKAGE = Perf::Trace::Context
|
||||
PROTOTYPES: ENABLE
|
||||
|
||||
int
|
||||
common_pc(context)
|
||||
struct scripting_context * context
|
||||
|
||||
int
|
||||
common_flags(context)
|
||||
struct scripting_context * context
|
||||
|
||||
int
|
||||
common_lock_depth(context)
|
||||
struct scripting_context * context
|
||||
|
||||
|
|
@ -0,0 +1,17 @@
|
|||
use 5.010000;
|
||||
use ExtUtils::MakeMaker;
|
||||
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
|
||||
# the contents of the Makefile that is written.
|
||||
WriteMakefile(
|
||||
NAME => 'Perf::Trace::Context',
|
||||
VERSION_FROM => 'lib/Perf/Trace/Context.pm', # finds $VERSION
|
||||
PREREQ_PM => {}, # e.g., Module::Name => 1.1
|
||||
($] >= 5.005 ? ## Add these new keywords supported since 5.005
|
||||
(ABSTRACT_FROM => 'lib/Perf/Trace/Context.pm', # retrieve abstract from module
|
||||
AUTHOR => 'Tom Zanussi <tzanussi@gmail.com>') : ()),
|
||||
LIBS => [''], # e.g., '-lm'
|
||||
DEFINE => '-I ../..', # e.g., '-DHAVE_SOMETHING'
|
||||
INC => '-I.', # e.g., '-I. -I/usr/include/other'
|
||||
# Un-comment this if you add C files to link with later:
|
||||
OBJECT => 'Context.o', # link all the C files too
|
||||
);
|
||||
|
|
@ -0,0 +1,59 @@
|
|||
Perf-Trace-Util version 0.01
|
||||
============================
|
||||
|
||||
This module contains utility functions for use with perf trace.
|
||||
|
||||
Core.pm and Util.pm are pure Perl modules; Core.pm contains routines
|
||||
that the core perf support for Perl calls on and should always be
|
||||
'used', while Util.pm contains useful but optional utility functions
|
||||
that scripts may want to use. Context.pm contains the Perl->C
|
||||
interface that allows scripts to access data in the embedding perf
|
||||
executable; scripts wishing to do that should 'use Context.pm'.
|
||||
|
||||
The Perl->C perf interface is completely driven by Context.xs. If you
|
||||
want to add new Perl functions that end up accessing C data in the
|
||||
perf executable, you add desciptions of the new functions here.
|
||||
scripting_context is a pointer to the perf data in the perf executable
|
||||
that you want to access - it's passed as the second parameter,
|
||||
$context, to all handler functions.
|
||||
|
||||
After you do that:
|
||||
|
||||
perl Makefile.PL # to create a Makefile for the next step
|
||||
make # to create Context.c
|
||||
|
||||
edit Context.c to add const to the char* file = __FILE__ line in
|
||||
XS(boot_Perf__Trace__Context) to silence a warning/error.
|
||||
|
||||
You can delete the Makefile, object files and anything else that was
|
||||
generated e.g. blib and shared library, etc, except for of course
|
||||
Context.c
|
||||
|
||||
You should then be able to run the normal perf make as usual.
|
||||
|
||||
INSTALLATION
|
||||
|
||||
Building perf with perf trace Perl scripting should install this
|
||||
module in the right place.
|
||||
|
||||
You should make sure libperl and ExtUtils/Embed.pm are installed first
|
||||
e.g. apt-get install libperl-dev or yum install perl-ExtUtils-Embed.
|
||||
|
||||
DEPENDENCIES
|
||||
|
||||
This module requires these other modules and libraries:
|
||||
|
||||
None
|
||||
|
||||
COPYRIGHT AND LICENCE
|
||||
|
||||
Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com>
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
Alternatively, this software may be distributed under the terms of the
|
||||
GNU General Public License ("GPL") version 2 as published by the Free
|
||||
Software Foundation.
|
||||
|
||||
|
|
@ -0,0 +1,55 @@
|
|||
package Perf::Trace::Context;
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw(
|
||||
) ] );
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw(
|
||||
common_pc common_flags common_lock_depth
|
||||
);
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
require XSLoader;
|
||||
XSLoader::load('Perf::Trace::Context', $VERSION);
|
||||
|
||||
1;
|
||||
__END__
|
||||
=head1 NAME
|
||||
|
||||
Perf::Trace::Context - Perl extension for accessing functions in perf.
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Perf::Trace::Context;
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Perf (trace) documentation
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2009 by Tom Zanussi
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
Alternatively, this software may be distributed under the terms of the
|
||||
GNU General Public License ("GPL") version 2 as published by the Free
|
||||
Software Foundation.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,192 @@
|
|||
package Perf::Trace::Core;
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw(
|
||||
) ] );
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw(
|
||||
define_flag_field define_flag_value flag_str dump_flag_fields
|
||||
define_symbolic_field define_symbolic_value symbol_str dump_symbolic_fields
|
||||
trace_flag_str
|
||||
);
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
my %trace_flags = (0x00 => "NONE",
|
||||
0x01 => "IRQS_OFF",
|
||||
0x02 => "IRQS_NOSUPPORT",
|
||||
0x04 => "NEED_RESCHED",
|
||||
0x08 => "HARDIRQ",
|
||||
0x10 => "SOFTIRQ");
|
||||
|
||||
sub trace_flag_str
|
||||
{
|
||||
my ($value) = @_;
|
||||
|
||||
my $string;
|
||||
|
||||
my $print_delim = 0;
|
||||
|
||||
foreach my $idx (sort {$a <=> $b} keys %trace_flags) {
|
||||
if (!$value && !$idx) {
|
||||
$string .= "NONE";
|
||||
last;
|
||||
}
|
||||
|
||||
if ($idx && ($value & $idx) == $idx) {
|
||||
if ($print_delim) {
|
||||
$string .= " | ";
|
||||
}
|
||||
$string .= "$trace_flags{$idx}";
|
||||
$print_delim = 1;
|
||||
$value &= ~$idx;
|
||||
}
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
my %flag_fields;
|
||||
my %symbolic_fields;
|
||||
|
||||
sub flag_str
|
||||
{
|
||||
my ($event_name, $field_name, $value) = @_;
|
||||
|
||||
my $string;
|
||||
|
||||
if ($flag_fields{$event_name}{$field_name}) {
|
||||
my $print_delim = 0;
|
||||
foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event_name}{$field_name}{"values"}}) {
|
||||
if (!$value && !$idx) {
|
||||
$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
|
||||
last;
|
||||
}
|
||||
if ($idx && ($value & $idx) == $idx) {
|
||||
if ($print_delim && $flag_fields{$event_name}{$field_name}{'delim'}) {
|
||||
$string .= " $flag_fields{$event_name}{$field_name}{'delim'} ";
|
||||
}
|
||||
$string .= "$flag_fields{$event_name}{$field_name}{'values'}{$idx}";
|
||||
$print_delim = 1;
|
||||
$value &= ~$idx;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return $string;
|
||||
}
|
||||
|
||||
sub define_flag_field
|
||||
{
|
||||
my ($event_name, $field_name, $delim) = @_;
|
||||
|
||||
$flag_fields{$event_name}{$field_name}{"delim"} = $delim;
|
||||
}
|
||||
|
||||
sub define_flag_value
|
||||
{
|
||||
my ($event_name, $field_name, $value, $field_str) = @_;
|
||||
|
||||
$flag_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
|
||||
}
|
||||
|
||||
sub dump_flag_fields
|
||||
{
|
||||
for my $event (keys %flag_fields) {
|
||||
print "event $event:\n";
|
||||
for my $field (keys %{$flag_fields{$event}}) {
|
||||
print " field: $field:\n";
|
||||
print " delim: $flag_fields{$event}{$field}{'delim'}\n";
|
||||
foreach my $idx (sort {$a <=> $b} keys %{$flag_fields{$event}{$field}{"values"}}) {
|
||||
print " value $idx: $flag_fields{$event}{$field}{'values'}{$idx}\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub symbol_str
|
||||
{
|
||||
my ($event_name, $field_name, $value) = @_;
|
||||
|
||||
if ($symbolic_fields{$event_name}{$field_name}) {
|
||||
foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event_name}{$field_name}{"values"}}) {
|
||||
if (!$value && !$idx) {
|
||||
return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
|
||||
last;
|
||||
}
|
||||
if ($value == $idx) {
|
||||
return "$symbolic_fields{$event_name}{$field_name}{'values'}{$idx}";
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
return undef;
|
||||
}
|
||||
|
||||
sub define_symbolic_field
|
||||
{
|
||||
my ($event_name, $field_name) = @_;
|
||||
|
||||
# nothing to do, really
|
||||
}
|
||||
|
||||
sub define_symbolic_value
|
||||
{
|
||||
my ($event_name, $field_name, $value, $field_str) = @_;
|
||||
|
||||
$symbolic_fields{$event_name}{$field_name}{"values"}{$value} = $field_str;
|
||||
}
|
||||
|
||||
sub dump_symbolic_fields
|
||||
{
|
||||
for my $event (keys %symbolic_fields) {
|
||||
print "event $event:\n";
|
||||
for my $field (keys %{$symbolic_fields{$event}}) {
|
||||
print " field: $field:\n";
|
||||
foreach my $idx (sort {$a <=> $b} keys %{$symbolic_fields{$event}{$field}{"values"}}) {
|
||||
print " value $idx: $symbolic_fields{$event}{$field}{'values'}{$idx}\n";
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
=head1 NAME
|
||||
|
||||
Perf::Trace::Core - Perl extension for perf trace
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Perf::Trace::Core
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Perf (trace) documentation
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2009 by Tom Zanussi
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
Alternatively, this software may be distributed under the terms of the
|
||||
GNU General Public License ("GPL") version 2 as published by the Free
|
||||
Software Foundation.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1,88 @@
|
|||
package Perf::Trace::Util;
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
require Exporter;
|
||||
|
||||
our @ISA = qw(Exporter);
|
||||
|
||||
our %EXPORT_TAGS = ( 'all' => [ qw(
|
||||
) ] );
|
||||
|
||||
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
|
||||
|
||||
our @EXPORT = qw(
|
||||
avg nsecs nsecs_secs nsecs_nsecs nsecs_usecs print_nsecs
|
||||
);
|
||||
|
||||
our $VERSION = '0.01';
|
||||
|
||||
sub avg
|
||||
{
|
||||
my ($total, $n) = @_;
|
||||
|
||||
return $total / $n;
|
||||
}
|
||||
|
||||
my $NSECS_PER_SEC = 1000000000;
|
||||
|
||||
sub nsecs
|
||||
{
|
||||
my ($secs, $nsecs) = @_;
|
||||
|
||||
return $secs * $NSECS_PER_SEC + $nsecs;
|
||||
}
|
||||
|
||||
sub nsecs_secs {
|
||||
my ($nsecs) = @_;
|
||||
|
||||
return $nsecs / $NSECS_PER_SEC;
|
||||
}
|
||||
|
||||
sub nsecs_nsecs {
|
||||
my ($nsecs) = @_;
|
||||
|
||||
return $nsecs - nsecs_secs($nsecs);
|
||||
}
|
||||
|
||||
sub nsecs_str {
|
||||
my ($nsecs) = @_;
|
||||
|
||||
my $str = sprintf("%5u.%09u", nsecs_secs($nsecs), nsecs_nsecs($nsecs));
|
||||
|
||||
return $str;
|
||||
}
|
||||
|
||||
1;
|
||||
__END__
|
||||
=head1 NAME
|
||||
|
||||
Perf::Trace::Util - Perl extension for perf trace
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
use Perf::Trace::Util;
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
Perf (trace) documentation
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Tom Zanussi, E<lt>tzanussi@gmail.com<gt>
|
||||
|
||||
=head1 COPYRIGHT AND LICENSE
|
||||
|
||||
Copyright (C) 2009 by Tom Zanussi
|
||||
|
||||
This library is free software; you can redistribute it and/or modify
|
||||
it under the same terms as Perl itself, either Perl version 5.10.0 or,
|
||||
at your option, any later version of Perl 5 you may have available.
|
||||
|
||||
Alternatively, this software may be distributed under the terms of the
|
||||
GNU General Public License ("GPL") version 2 as published by the Free
|
||||
Software Foundation.
|
||||
|
||||
=cut
|
||||
|
|
@ -0,0 +1 @@
|
|||
struct scripting_context * T_PTR
|
||||
|
|
@ -0,0 +1,7 @@
|
|||
#!/bin/bash
|
||||
perf record -c 1 -f -a -M -R -e kmem:kmalloc -e irq:softirq_entry
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
#!/bin/bash
|
||||
perf trace -s ~/libexec/perf-core/scripts/perl/check-perf-trace.pl
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#!/bin/bash
|
||||
perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_enter_write
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
#!/bin/bash
|
||||
perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#!/bin/bash
|
||||
perf 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
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
#!/bin/bash
|
||||
perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
#!/bin/bash
|
||||
perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,5 @@
|
|||
#!/bin/bash
|
||||
perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,2 @@
|
|||
#!/bin/bash
|
||||
perf record -c 1 -f -a -M -R -e workqueue:workqueue_creation -e workqueue:workqueue_destruction -e workqueue:workqueue_execution -e workqueue:workqueue_insertion
|
||||
|
|
@ -0,0 +1,6 @@
|
|||
#!/bin/bash
|
||||
perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl
|
||||
|
||||
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,106 @@
|
|||
# perf trace event handlers, generated by perf trace -g perl
|
||||
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
|
||||
# Licensed under the terms of the GNU GPL License version 2
|
||||
|
||||
# This script tests basic functionality such as flag and symbol
|
||||
# strings, common_xxx() calls back into perf, begin, end, unhandled
|
||||
# events, etc. Basically, if this script runs successfully and
|
||||
# displays expected results, perl scripting support should be ok.
|
||||
|
||||
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
|
||||
use lib "./Perf-Trace-Util/lib";
|
||||
use Perf::Trace::Core;
|
||||
use Perf::Trace::Context;
|
||||
use Perf::Trace::Util;
|
||||
|
||||
sub trace_begin
|
||||
{
|
||||
print "trace_begin\n";
|
||||
}
|
||||
|
||||
sub trace_end
|
||||
{
|
||||
print "trace_end\n";
|
||||
|
||||
print_unhandled();
|
||||
}
|
||||
|
||||
sub irq::softirq_entry
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$vec) = @_;
|
||||
|
||||
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm);
|
||||
|
||||
print_uncommon($context);
|
||||
|
||||
printf("vec=%s\n",
|
||||
symbol_str("irq::softirq_entry", "vec", $vec));
|
||||
}
|
||||
|
||||
sub kmem::kmalloc
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$call_site, $ptr, $bytes_req, $bytes_alloc,
|
||||
$gfp_flags) = @_;
|
||||
|
||||
print_header($event_name, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm);
|
||||
|
||||
print_uncommon($context);
|
||||
|
||||
printf("call_site=%p, ptr=%p, bytes_req=%u, bytes_alloc=%u, ".
|
||||
"gfp_flags=%s\n",
|
||||
$call_site, $ptr, $bytes_req, $bytes_alloc,
|
||||
|
||||
flag_str("kmem::kmalloc", "gfp_flags", $gfp_flags));
|
||||
}
|
||||
|
||||
# print trace fields not included in handler args
|
||||
sub print_uncommon
|
||||
{
|
||||
my ($context) = @_;
|
||||
|
||||
printf("common_preempt_count=%d, common_flags=%s, common_lock_depth=%d, ",
|
||||
common_pc($context), trace_flag_str(common_flags($context)),
|
||||
common_lock_depth($context));
|
||||
|
||||
}
|
||||
|
||||
my %unhandled;
|
||||
|
||||
sub print_unhandled
|
||||
{
|
||||
if ((scalar keys %unhandled) == 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
print "\nunhandled events:\n\n";
|
||||
|
||||
printf("%-40s %10s\n", "event", "count");
|
||||
printf("%-40s %10s\n", "----------------------------------------",
|
||||
"-----------");
|
||||
|
||||
foreach my $event_name (keys %unhandled) {
|
||||
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_unhandled
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm) = @_;
|
||||
|
||||
$unhandled{$event_name}++;
|
||||
}
|
||||
|
||||
sub print_header
|
||||
{
|
||||
my ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;
|
||||
|
||||
printf("%-20s %5u %05u.%09u %8u %-20s ",
|
||||
$event_name, $cpu, $secs, $nsecs, $pid, $comm);
|
||||
}
|
||||
|
|
@ -0,0 +1,105 @@
|
|||
#!/usr/bin/perl -w
|
||||
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
|
||||
# Licensed under the terms of the GNU GPL License version 2
|
||||
|
||||
# Display r/w activity for files read/written to for a given program
|
||||
|
||||
# The common_* event handler fields are the most useful fields common to
|
||||
# all events. They don't necessarily correspond to the 'common_*' fields
|
||||
# in the status files. Those fields not available as handler params can
|
||||
# be retrieved via script functions of the form get_common_*().
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
|
||||
use lib "./Perf-Trace-Util/lib";
|
||||
use Perf::Trace::Core;
|
||||
use Perf::Trace::Util;
|
||||
|
||||
# change this to the comm of the program you're interested in
|
||||
my $for_comm = "perf";
|
||||
|
||||
my %reads;
|
||||
my %writes;
|
||||
|
||||
sub syscalls::sys_enter_read
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
|
||||
|
||||
if ($common_comm eq $for_comm) {
|
||||
$reads{$fd}{bytes_requested} += $count;
|
||||
$reads{$fd}{total_reads}++;
|
||||
}
|
||||
}
|
||||
|
||||
sub syscalls::sys_enter_write
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm, $nr, $fd, $buf, $count) = @_;
|
||||
|
||||
if ($common_comm eq $for_comm) {
|
||||
$writes{$fd}{bytes_written} += $count;
|
||||
$writes{$fd}{total_writes}++;
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_end
|
||||
{
|
||||
printf("file read counts for $for_comm:\n\n");
|
||||
|
||||
printf("%6s %10s %10s\n", "fd", "# reads", "bytes_requested");
|
||||
printf("%6s %10s %10s\n", "------", "----------", "-----------");
|
||||
|
||||
foreach my $fd (sort {$reads{$b}{bytes_requested} <=>
|
||||
$reads{$a}{bytes_requested}} keys %reads) {
|
||||
my $total_reads = $reads{$fd}{total_reads};
|
||||
my $bytes_requested = $reads{$fd}{bytes_requested};
|
||||
printf("%6u %10u %10u\n", $fd, $total_reads, $bytes_requested);
|
||||
}
|
||||
|
||||
printf("\nfile write counts for $for_comm:\n\n");
|
||||
|
||||
printf("%6s %10s %10s\n", "fd", "# writes", "bytes_written");
|
||||
printf("%6s %10s %10s\n", "------", "----------", "-----------");
|
||||
|
||||
foreach my $fd (sort {$writes{$b}{bytes_written} <=>
|
||||
$writes{$a}{bytes_written}} keys %writes) {
|
||||
my $total_writes = $writes{$fd}{total_writes};
|
||||
my $bytes_written = $writes{$fd}{bytes_written};
|
||||
printf("%6u %10u %10u\n", $fd, $total_writes, $bytes_written);
|
||||
}
|
||||
|
||||
print_unhandled();
|
||||
}
|
||||
|
||||
my %unhandled;
|
||||
|
||||
sub print_unhandled
|
||||
{
|
||||
if ((scalar keys %unhandled) == 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
print "\nunhandled events:\n\n";
|
||||
|
||||
printf("%-40s %10s\n", "event", "count");
|
||||
printf("%-40s %10s\n", "----------------------------------------",
|
||||
"-----------");
|
||||
|
||||
foreach my $event_name (keys %unhandled) {
|
||||
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_unhandled
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm) = @_;
|
||||
|
||||
$unhandled{$event_name}++;
|
||||
}
|
||||
|
||||
|
||||
|
|
@ -0,0 +1,170 @@
|
|||
#!/usr/bin/perl -w
|
||||
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
|
||||
# Licensed under the terms of the GNU GPL License version 2
|
||||
|
||||
# Display r/w activity for all processes
|
||||
|
||||
# The common_* event handler fields are the most useful fields common to
|
||||
# all events. They don't necessarily correspond to the 'common_*' fields
|
||||
# in the status files. Those fields not available as handler params can
|
||||
# be retrieved via script functions of the form get_common_*().
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
|
||||
use lib "./Perf-Trace-Util/lib";
|
||||
use Perf::Trace::Core;
|
||||
use Perf::Trace::Util;
|
||||
|
||||
my %reads;
|
||||
my %writes;
|
||||
|
||||
sub syscalls::sys_exit_read
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$nr, $ret) = @_;
|
||||
|
||||
if ($ret > 0) {
|
||||
$reads{$common_pid}{bytes_read} += $ret;
|
||||
} else {
|
||||
if (!defined ($reads{$common_pid}{bytes_read})) {
|
||||
$reads{$common_pid}{bytes_read} = 0;
|
||||
}
|
||||
$reads{$common_pid}{errors}{$ret}++;
|
||||
}
|
||||
}
|
||||
|
||||
sub syscalls::sys_enter_read
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$nr, $fd, $buf, $count) = @_;
|
||||
|
||||
$reads{$common_pid}{bytes_requested} += $count;
|
||||
$reads{$common_pid}{total_reads}++;
|
||||
$reads{$common_pid}{comm} = $common_comm;
|
||||
}
|
||||
|
||||
sub syscalls::sys_exit_write
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$nr, $ret) = @_;
|
||||
|
||||
if ($ret <= 0) {
|
||||
$writes{$common_pid}{errors}{$ret}++;
|
||||
}
|
||||
}
|
||||
|
||||
sub syscalls::sys_enter_write
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$nr, $fd, $buf, $count) = @_;
|
||||
|
||||
$writes{$common_pid}{bytes_written} += $count;
|
||||
$writes{$common_pid}{total_writes}++;
|
||||
$writes{$common_pid}{comm} = $common_comm;
|
||||
}
|
||||
|
||||
sub trace_end
|
||||
{
|
||||
printf("read counts by pid:\n\n");
|
||||
|
||||
printf("%6s %20s %10s %10s %10s\n", "pid", "comm",
|
||||
"# reads", "bytes_requested", "bytes_read");
|
||||
printf("%6s %-20s %10s %10s %10s\n", "------", "--------------------",
|
||||
"-----------", "----------", "----------");
|
||||
|
||||
foreach my $pid (sort {$reads{$b}{bytes_read} <=>
|
||||
$reads{$a}{bytes_read}} keys %reads) {
|
||||
my $comm = $reads{$pid}{comm};
|
||||
my $total_reads = $reads{$pid}{total_reads};
|
||||
my $bytes_requested = $reads{$pid}{bytes_requested};
|
||||
my $bytes_read = $reads{$pid}{bytes_read};
|
||||
|
||||
printf("%6s %-20s %10s %10s %10s\n", $pid, $comm,
|
||||
$total_reads, $bytes_requested, $bytes_read);
|
||||
}
|
||||
|
||||
printf("\nfailed reads by pid:\n\n");
|
||||
|
||||
printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
|
||||
printf("%6s %20s %6s %10s\n", "------", "--------------------",
|
||||
"------", "----------");
|
||||
|
||||
foreach my $pid (keys %reads) {
|
||||
my $comm = $reads{$pid}{comm};
|
||||
foreach my $err (sort {$reads{$b}{comm} cmp $reads{$a}{comm}}
|
||||
keys %{$reads{$pid}{errors}}) {
|
||||
my $errors = $reads{$pid}{errors}{$err};
|
||||
|
||||
printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
|
||||
}
|
||||
}
|
||||
|
||||
printf("\nwrite counts by pid:\n\n");
|
||||
|
||||
printf("%6s %20s %10s %10s\n", "pid", "comm",
|
||||
"# writes", "bytes_written");
|
||||
printf("%6s %-20s %10s %10s\n", "------", "--------------------",
|
||||
"-----------", "----------");
|
||||
|
||||
foreach my $pid (sort {$writes{$b}{bytes_written} <=>
|
||||
$writes{$a}{bytes_written}} keys %writes) {
|
||||
my $comm = $writes{$pid}{comm};
|
||||
my $total_writes = $writes{$pid}{total_writes};
|
||||
my $bytes_written = $writes{$pid}{bytes_written};
|
||||
|
||||
printf("%6s %-20s %10s %10s\n", $pid, $comm,
|
||||
$total_writes, $bytes_written);
|
||||
}
|
||||
|
||||
printf("\nfailed writes by pid:\n\n");
|
||||
|
||||
printf("%6s %20s %6s %10s\n", "pid", "comm", "error #", "# errors");
|
||||
printf("%6s %20s %6s %10s\n", "------", "--------------------",
|
||||
"------", "----------");
|
||||
|
||||
foreach my $pid (keys %writes) {
|
||||
my $comm = $writes{$pid}{comm};
|
||||
foreach my $err (sort {$writes{$b}{comm} cmp $writes{$a}{comm}}
|
||||
keys %{$writes{$pid}{errors}}) {
|
||||
my $errors = $writes{$pid}{errors}{$err};
|
||||
|
||||
printf("%6d %-20s %6d %10s\n", $pid, $comm, $err, $errors);
|
||||
}
|
||||
}
|
||||
|
||||
print_unhandled();
|
||||
}
|
||||
|
||||
my %unhandled;
|
||||
|
||||
sub print_unhandled
|
||||
{
|
||||
if ((scalar keys %unhandled) == 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
print "\nunhandled events:\n\n";
|
||||
|
||||
printf("%-40s %10s\n", "event", "count");
|
||||
printf("%-40s %10s\n", "----------------------------------------",
|
||||
"-----------");
|
||||
|
||||
foreach my $event_name (keys %unhandled) {
|
||||
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_unhandled
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm) = @_;
|
||||
|
||||
$unhandled{$event_name}++;
|
||||
}
|
||||
|
|
@ -0,0 +1,103 @@
|
|||
#!/usr/bin/perl -w
|
||||
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
|
||||
# Licensed under the terms of the GNU GPL License version 2
|
||||
|
||||
# Display avg/min/max wakeup latency
|
||||
|
||||
# The common_* event handler fields are the most useful fields common to
|
||||
# all events. They don't necessarily correspond to the 'common_*' fields
|
||||
# in the status files. Those fields not available as handler params can
|
||||
# be retrieved via script functions of the form get_common_*().
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
|
||||
use lib "./Perf-Trace-Util/lib";
|
||||
use Perf::Trace::Core;
|
||||
use Perf::Trace::Util;
|
||||
|
||||
my %last_wakeup;
|
||||
|
||||
my $max_wakeup_latency;
|
||||
my $min_wakeup_latency;
|
||||
my $total_wakeup_latency;
|
||||
my $total_wakeups;
|
||||
|
||||
sub sched::sched_switch
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$prev_comm, $prev_pid, $prev_prio, $prev_state, $next_comm, $next_pid,
|
||||
$next_prio) = @_;
|
||||
|
||||
my $wakeup_ts = $last_wakeup{$common_cpu}{ts};
|
||||
if ($wakeup_ts) {
|
||||
my $switch_ts = nsecs($common_secs, $common_nsecs);
|
||||
my $wakeup_latency = $switch_ts - $wakeup_ts;
|
||||
if ($wakeup_latency > $max_wakeup_latency) {
|
||||
$max_wakeup_latency = $wakeup_latency;
|
||||
}
|
||||
if ($wakeup_latency < $min_wakeup_latency) {
|
||||
$min_wakeup_latency = $wakeup_latency;
|
||||
}
|
||||
$total_wakeup_latency += $wakeup_latency;
|
||||
$total_wakeups++;
|
||||
}
|
||||
$last_wakeup{$common_cpu}{ts} = 0;
|
||||
}
|
||||
|
||||
sub sched::sched_wakeup
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$comm, $pid, $prio, $success, $target_cpu) = @_;
|
||||
|
||||
$last_wakeup{$target_cpu}{ts} = nsecs($common_secs, $common_nsecs);
|
||||
}
|
||||
|
||||
sub trace_begin
|
||||
{
|
||||
$min_wakeup_latency = 1000000000;
|
||||
$max_wakeup_latency = 0;
|
||||
}
|
||||
|
||||
sub trace_end
|
||||
{
|
||||
printf("wakeup_latency stats:\n\n");
|
||||
print "total_wakeups: $total_wakeups\n";
|
||||
printf("avg_wakeup_latency (ns): %u\n",
|
||||
avg($total_wakeup_latency, $total_wakeups));
|
||||
printf("min_wakeup_latency (ns): %u\n", $min_wakeup_latency);
|
||||
printf("max_wakeup_latency (ns): %u\n", $max_wakeup_latency);
|
||||
|
||||
print_unhandled();
|
||||
}
|
||||
|
||||
my %unhandled;
|
||||
|
||||
sub print_unhandled
|
||||
{
|
||||
if ((scalar keys %unhandled) == 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
print "\nunhandled events:\n\n";
|
||||
|
||||
printf("%-40s %10s\n", "event", "count");
|
||||
printf("%-40s %10s\n", "----------------------------------------",
|
||||
"-----------");
|
||||
|
||||
foreach my $event_name (keys %unhandled) {
|
||||
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_unhandled
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm) = @_;
|
||||
|
||||
$unhandled{$event_name}++;
|
||||
}
|
||||
|
|
@ -0,0 +1,129 @@
|
|||
#!/usr/bin/perl -w
|
||||
# (c) 2009, Tom Zanussi <tzanussi@gmail.com>
|
||||
# Licensed under the terms of the GNU GPL License version 2
|
||||
|
||||
# Displays workqueue stats
|
||||
#
|
||||
# Usage:
|
||||
#
|
||||
# perf record -c 1 -f -a -R -e workqueue:workqueue_creation -e
|
||||
# workqueue:workqueue_destruction -e workqueue:workqueue_execution
|
||||
# -e workqueue:workqueue_insertion
|
||||
#
|
||||
# perf trace -p -s tools/perf/scripts/perl/workqueue-stats.pl
|
||||
|
||||
use 5.010000;
|
||||
use strict;
|
||||
use warnings;
|
||||
|
||||
use lib "$ENV{'PERF_EXEC_PATH'}/scripts/perl/Perf-Trace-Util/lib";
|
||||
use lib "./Perf-Trace-Util/lib";
|
||||
use Perf::Trace::Core;
|
||||
use Perf::Trace::Util;
|
||||
|
||||
my @cpus;
|
||||
|
||||
sub workqueue::workqueue_destruction
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$thread_comm, $thread_pid) = @_;
|
||||
|
||||
$cpus[$common_cpu]{$thread_pid}{destroyed}++;
|
||||
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
|
||||
}
|
||||
|
||||
sub workqueue::workqueue_creation
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$thread_comm, $thread_pid, $cpu) = @_;
|
||||
|
||||
$cpus[$common_cpu]{$thread_pid}{created}++;
|
||||
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
|
||||
}
|
||||
|
||||
sub workqueue::workqueue_execution
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$thread_comm, $thread_pid, $func) = @_;
|
||||
|
||||
$cpus[$common_cpu]{$thread_pid}{executed}++;
|
||||
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
|
||||
}
|
||||
|
||||
sub workqueue::workqueue_insertion
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm,
|
||||
$thread_comm, $thread_pid, $func) = @_;
|
||||
|
||||
$cpus[$common_cpu]{$thread_pid}{inserted}++;
|
||||
$cpus[$common_cpu]{$thread_pid}{comm} = $thread_comm;
|
||||
}
|
||||
|
||||
sub trace_end
|
||||
{
|
||||
print "workqueue work stats:\n\n";
|
||||
my $cpu = 0;
|
||||
printf("%3s %6s %6s\t%-20s\n", "cpu", "ins", "exec", "name");
|
||||
printf("%3s %6s %6s\t%-20s\n", "---", "---", "----", "----");
|
||||
foreach my $pidhash (@cpus) {
|
||||
while ((my $pid, my $wqhash) = each %$pidhash) {
|
||||
my $ins = $$wqhash{'inserted'};
|
||||
my $exe = $$wqhash{'executed'};
|
||||
my $comm = $$wqhash{'comm'};
|
||||
if ($ins || $exe) {
|
||||
printf("%3u %6u %6u\t%-20s\n", $cpu, $ins, $exe, $comm);
|
||||
}
|
||||
}
|
||||
$cpu++;
|
||||
}
|
||||
|
||||
$cpu = 0;
|
||||
print "\nworkqueue lifecycle stats:\n\n";
|
||||
printf("%3s %6s %6s\t%-20s\n", "cpu", "created", "destroyed", "name");
|
||||
printf("%3s %6s %6s\t%-20s\n", "---", "-------", "---------", "----");
|
||||
foreach my $pidhash (@cpus) {
|
||||
while ((my $pid, my $wqhash) = each %$pidhash) {
|
||||
my $created = $$wqhash{'created'};
|
||||
my $destroyed = $$wqhash{'destroyed'};
|
||||
my $comm = $$wqhash{'comm'};
|
||||
if ($created || $destroyed) {
|
||||
printf("%3u %6u %6u\t%-20s\n", $cpu, $created, $destroyed,
|
||||
$comm);
|
||||
}
|
||||
}
|
||||
$cpu++;
|
||||
}
|
||||
|
||||
print_unhandled();
|
||||
}
|
||||
|
||||
my %unhandled;
|
||||
|
||||
sub print_unhandled
|
||||
{
|
||||
if ((scalar keys %unhandled) == 0) {
|
||||
return;
|
||||
}
|
||||
|
||||
print "\nunhandled events:\n\n";
|
||||
|
||||
printf("%-40s %10s\n", "event", "count");
|
||||
printf("%-40s %10s\n", "----------------------------------------",
|
||||
"-----------");
|
||||
|
||||
foreach my $event_name (keys %unhandled) {
|
||||
printf("%-40s %10d\n", $event_name, $unhandled{$event_name});
|
||||
}
|
||||
}
|
||||
|
||||
sub trace_unhandled
|
||||
{
|
||||
my ($event_name, $context, $common_cpu, $common_secs, $common_nsecs,
|
||||
$common_pid, $common_comm) = @_;
|
||||
|
||||
$unhandled{$event_name}++;
|
||||
}
|
||||
|
|
@ -48,6 +48,11 @@ static unsigned long long input_buf_siz;
|
|||
|
||||
static int cpus;
|
||||
static int long_size;
|
||||
static int is_flag_field;
|
||||
static int is_symbolic_field;
|
||||
|
||||
static struct format_field *
|
||||
find_any_field(struct event *event, const char *name);
|
||||
|
||||
static void init_input_buf(char *buf, unsigned long long size)
|
||||
{
|
||||
|
|
@ -1301,6 +1306,16 @@ process_entry(struct event *event __unused, struct print_arg *arg,
|
|||
arg->type = PRINT_FIELD;
|
||||
arg->field.name = field;
|
||||
|
||||
if (is_flag_field) {
|
||||
arg->field.field = find_any_field(event, arg->field.name);
|
||||
arg->field.field->flags |= FIELD_IS_FLAG;
|
||||
is_flag_field = 0;
|
||||
} else if (is_symbolic_field) {
|
||||
arg->field.field = find_any_field(event, arg->field.name);
|
||||
arg->field.field->flags |= FIELD_IS_SYMBOLIC;
|
||||
is_symbolic_field = 0;
|
||||
}
|
||||
|
||||
type = read_token(&token);
|
||||
*tok = token;
|
||||
|
||||
|
|
@ -1668,9 +1683,11 @@ process_arg_token(struct event *event, struct print_arg *arg,
|
|||
type = process_entry(event, arg, &token);
|
||||
} else if (strcmp(token, "__print_flags") == 0) {
|
||||
free_token(token);
|
||||
is_flag_field = 1;
|
||||
type = process_flags(event, arg, &token);
|
||||
} else if (strcmp(token, "__print_symbolic") == 0) {
|
||||
free_token(token);
|
||||
is_symbolic_field = 1;
|
||||
type = process_symbols(event, arg, &token);
|
||||
} else if (strcmp(token, "__get_str") == 0) {
|
||||
free_token(token);
|
||||
|
|
@ -1871,7 +1888,7 @@ find_any_field(struct event *event, const char *name)
|
|||
return find_field(event, name);
|
||||
}
|
||||
|
||||
static unsigned long long read_size(void *ptr, int size)
|
||||
unsigned long long read_size(void *ptr, int size)
|
||||
{
|
||||
switch (size) {
|
||||
case 1:
|
||||
|
|
@ -1956,7 +1973,7 @@ int trace_parse_common_type(void *data)
|
|||
"common_type");
|
||||
}
|
||||
|
||||
static int parse_common_pid(void *data)
|
||||
int trace_parse_common_pid(void *data)
|
||||
{
|
||||
static int pid_offset;
|
||||
static int pid_size;
|
||||
|
|
@ -1965,7 +1982,7 @@ static int parse_common_pid(void *data)
|
|||
"common_pid");
|
||||
}
|
||||
|
||||
static int parse_common_pc(void *data)
|
||||
int parse_common_pc(void *data)
|
||||
{
|
||||
static int pc_offset;
|
||||
static int pc_size;
|
||||
|
|
@ -1974,7 +1991,7 @@ static int parse_common_pc(void *data)
|
|||
"common_preempt_count");
|
||||
}
|
||||
|
||||
static int parse_common_flags(void *data)
|
||||
int parse_common_flags(void *data)
|
||||
{
|
||||
static int flags_offset;
|
||||
static int flags_size;
|
||||
|
|
@ -1983,7 +2000,7 @@ static int parse_common_flags(void *data)
|
|||
"common_flags");
|
||||
}
|
||||
|
||||
static int parse_common_lock_depth(void *data)
|
||||
int parse_common_lock_depth(void *data)
|
||||
{
|
||||
static int ld_offset;
|
||||
static int ld_size;
|
||||
|
|
@ -2008,6 +2025,14 @@ struct event *trace_find_event(int id)
|
|||
return event;
|
||||
}
|
||||
|
||||
struct event *trace_find_next_event(struct event *event)
|
||||
{
|
||||
if (!event)
|
||||
return event_list;
|
||||
|
||||
return event->next;
|
||||
}
|
||||
|
||||
static unsigned long long eval_num_arg(void *data, int size,
|
||||
struct event *event, struct print_arg *arg)
|
||||
{
|
||||
|
|
@ -2147,7 +2172,7 @@ static const struct flag flags[] = {
|
|||
{ "HRTIMER_RESTART", 1 },
|
||||
};
|
||||
|
||||
static unsigned long long eval_flag(const char *flag)
|
||||
unsigned long long eval_flag(const char *flag)
|
||||
{
|
||||
int i;
|
||||
|
||||
|
|
@ -2677,7 +2702,7 @@ get_return_for_leaf(int cpu, int cur_pid, unsigned long long cur_func,
|
|||
if (!(event->flags & EVENT_FL_ISFUNCRET))
|
||||
return NULL;
|
||||
|
||||
pid = parse_common_pid(next->data);
|
||||
pid = trace_parse_common_pid(next->data);
|
||||
field = find_field(event, "func");
|
||||
if (!field)
|
||||
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,
|
|||
return;
|
||||
}
|
||||
|
||||
pid = parse_common_pid(data);
|
||||
pid = trace_parse_common_pid(data);
|
||||
|
||||
if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET))
|
||||
return pretty_print_func_graph(data, size, event, cpu,
|
||||
|
|
|
|||
|
|
@ -0,0 +1,598 @@
|
|||
/*
|
||||
* trace-event-perl. Feed perf trace events to an embedded Perl interpreter.
|
||||
*
|
||||
* Copyright (C) 2009 Tom Zanussi <tzanussi@gmail.com>
|
||||
*
|
||||
* This program is free software; you can redistribute it and/or modify
|
||||
* it under the terms of the GNU General Public License as published by
|
||||
* the Free Software Foundation; either version 2 of the License, or
|
||||
* (at your option) any later version.
|
||||
*
|
||||
* This program is distributed in the hope that it will be useful,
|
||||
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||
* GNU General Public License for more details.
|
||||
*
|
||||
* You should have received a copy of the GNU General Public License
|
||||
* along with this program; if not, write to the Free Software
|
||||
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <ctype.h>
|
||||
#include <errno.h>
|
||||
|
||||
#include "../perf.h"
|
||||
#include "util.h"
|
||||
#include "trace-event.h"
|
||||
#include "trace-event-perl.h"
|
||||
|
||||
void xs_init(pTHX);
|
||||
|
||||
void boot_Perf__Trace__Context(pTHX_ CV *cv);
|
||||
void boot_DynaLoader(pTHX_ CV *cv);
|
||||
|
||||
void xs_init(pTHX)
|
||||
{
|
||||
const char *file = __FILE__;
|
||||
dXSUB_SYS;
|
||||
|
||||
newXS("Perf::Trace::Context::bootstrap", boot_Perf__Trace__Context,
|
||||
file);
|
||||
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
|
||||
}
|
||||
|
||||
INTERP my_perl;
|
||||
|
||||
#define FTRACE_MAX_EVENT \
|
||||
((1 << (sizeof(unsigned short) * 8)) - 1)
|
||||
|
||||
struct event *events[FTRACE_MAX_EVENT];
|
||||
|
||||
static struct scripting_context *scripting_context;
|
||||
|
||||
static char *cur_field_name;
|
||||
static int zero_flag_atom;
|
||||
|
||||
static void define_symbolic_value(const char *ev_name,
|
||||
const char *field_name,
|
||||
const char *field_value,
|
||||
const char *field_str)
|
||||
{
|
||||
unsigned long long value;
|
||||
dSP;
|
||||
|
||||
value = eval_flag(field_value);
|
||||
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(SP);
|
||||
|
||||
XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVuv(value)));
|
||||
XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
|
||||
|
||||
PUTBACK;
|
||||
if (get_cv("main::define_symbolic_value", 0))
|
||||
call_pv("main::define_symbolic_value", G_SCALAR);
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
static void define_symbolic_values(struct print_flag_sym *field,
|
||||
const char *ev_name,
|
||||
const char *field_name)
|
||||
{
|
||||
define_symbolic_value(ev_name, field_name, field->value, field->str);
|
||||
if (field->next)
|
||||
define_symbolic_values(field->next, ev_name, field_name);
|
||||
}
|
||||
|
||||
static void define_symbolic_field(const char *ev_name,
|
||||
const char *field_name)
|
||||
{
|
||||
dSP;
|
||||
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(SP);
|
||||
|
||||
XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
|
||||
|
||||
PUTBACK;
|
||||
if (get_cv("main::define_symbolic_field", 0))
|
||||
call_pv("main::define_symbolic_field", G_SCALAR);
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
static void define_flag_value(const char *ev_name,
|
||||
const char *field_name,
|
||||
const char *field_value,
|
||||
const char *field_str)
|
||||
{
|
||||
unsigned long long value;
|
||||
dSP;
|
||||
|
||||
value = eval_flag(field_value);
|
||||
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(SP);
|
||||
|
||||
XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVuv(value)));
|
||||
XPUSHs(sv_2mortal(newSVpv(field_str, 0)));
|
||||
|
||||
PUTBACK;
|
||||
if (get_cv("main::define_flag_value", 0))
|
||||
call_pv("main::define_flag_value", G_SCALAR);
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
static void define_flag_values(struct print_flag_sym *field,
|
||||
const char *ev_name,
|
||||
const char *field_name)
|
||||
{
|
||||
define_flag_value(ev_name, field_name, field->value, field->str);
|
||||
if (field->next)
|
||||
define_flag_values(field->next, ev_name, field_name);
|
||||
}
|
||||
|
||||
static void define_flag_field(const char *ev_name,
|
||||
const char *field_name,
|
||||
const char *delim)
|
||||
{
|
||||
dSP;
|
||||
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(SP);
|
||||
|
||||
XPUSHs(sv_2mortal(newSVpv(ev_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(field_name, 0)));
|
||||
XPUSHs(sv_2mortal(newSVpv(delim, 0)));
|
||||
|
||||
PUTBACK;
|
||||
if (get_cv("main::define_flag_field", 0))
|
||||
call_pv("main::define_flag_field", G_SCALAR);
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
static void define_event_symbols(struct event *event,
|
||||
const char *ev_name,
|
||||
struct print_arg *args)
|
||||
{
|
||||
switch (args->type) {
|
||||
case PRINT_NULL:
|
||||
break;
|
||||
case PRINT_ATOM:
|
||||
define_flag_value(ev_name, cur_field_name, "0",
|
||||
args->atom.atom);
|
||||
zero_flag_atom = 0;
|
||||
break;
|
||||
case PRINT_FIELD:
|
||||
if (cur_field_name)
|
||||
free(cur_field_name);
|
||||
cur_field_name = strdup(args->field.name);
|
||||
break;
|
||||
case PRINT_FLAGS:
|
||||
define_event_symbols(event, ev_name, args->flags.field);
|
||||
define_flag_field(ev_name, cur_field_name, args->flags.delim);
|
||||
define_flag_values(args->flags.flags, ev_name, cur_field_name);
|
||||
break;
|
||||
case PRINT_SYMBOL:
|
||||
define_event_symbols(event, ev_name, args->symbol.field);
|
||||
define_symbolic_field(ev_name, cur_field_name);
|
||||
define_symbolic_values(args->symbol.symbols, ev_name,
|
||||
cur_field_name);
|
||||
break;
|
||||
case PRINT_STRING:
|
||||
break;
|
||||
case PRINT_TYPE:
|
||||
define_event_symbols(event, ev_name, args->typecast.item);
|
||||
break;
|
||||
case PRINT_OP:
|
||||
if (strcmp(args->op.op, ":") == 0)
|
||||
zero_flag_atom = 1;
|
||||
define_event_symbols(event, ev_name, args->op.left);
|
||||
define_event_symbols(event, ev_name, args->op.right);
|
||||
break;
|
||||
default:
|
||||
/* we should warn... */
|
||||
return;
|
||||
}
|
||||
|
||||
if (args->next)
|
||||
define_event_symbols(event, ev_name, args->next);
|
||||
}
|
||||
|
||||
static inline struct event *find_cache_event(int type)
|
||||
{
|
||||
static char ev_name[256];
|
||||
struct event *event;
|
||||
|
||||
if (events[type])
|
||||
return events[type];
|
||||
|
||||
events[type] = event = trace_find_event(type);
|
||||
if (!event)
|
||||
return NULL;
|
||||
|
||||
sprintf(ev_name, "%s::%s", event->system, event->name);
|
||||
|
||||
define_event_symbols(event, ev_name, event->print_fmt.args);
|
||||
|
||||
return event;
|
||||
}
|
||||
|
||||
int common_pc(struct scripting_context *context)
|
||||
{
|
||||
int pc;
|
||||
|
||||
pc = parse_common_pc(context->event_data);
|
||||
|
||||
return pc;
|
||||
}
|
||||
|
||||
int common_flags(struct scripting_context *context)
|
||||
{
|
||||
int flags;
|
||||
|
||||
flags = parse_common_flags(context->event_data);
|
||||
|
||||
return flags;
|
||||
}
|
||||
|
||||
int common_lock_depth(struct scripting_context *context)
|
||||
{
|
||||
int lock_depth;
|
||||
|
||||
lock_depth = parse_common_lock_depth(context->event_data);
|
||||
|
||||
return lock_depth;
|
||||
}
|
||||
|
||||
static void perl_process_event(int cpu, void *data,
|
||||
int size __attribute((unused)),
|
||||
unsigned long long nsecs, char *comm)
|
||||
{
|
||||
struct format_field *field;
|
||||
static char handler[256];
|
||||
unsigned long long val;
|
||||
unsigned long s, ns;
|
||||
struct event *event;
|
||||
int type;
|
||||
int pid;
|
||||
|
||||
dSP;
|
||||
|
||||
type = trace_parse_common_type(data);
|
||||
|
||||
event = find_cache_event(type);
|
||||
if (!event)
|
||||
die("ug! no event found for type %d", type);
|
||||
|
||||
pid = trace_parse_common_pid(data);
|
||||
|
||||
sprintf(handler, "%s::%s", event->system, event->name);
|
||||
|
||||
s = nsecs / NSECS_PER_SEC;
|
||||
ns = nsecs - s * NSECS_PER_SEC;
|
||||
|
||||
scripting_context->event_data = data;
|
||||
|
||||
ENTER;
|
||||
SAVETMPS;
|
||||
PUSHMARK(SP);
|
||||
|
||||
XPUSHs(sv_2mortal(newSVpv(handler, 0)));
|
||||
XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
|
||||
XPUSHs(sv_2mortal(newSVuv(cpu)));
|
||||
XPUSHs(sv_2mortal(newSVuv(s)));
|
||||
XPUSHs(sv_2mortal(newSVuv(ns)));
|
||||
XPUSHs(sv_2mortal(newSViv(pid)));
|
||||
XPUSHs(sv_2mortal(newSVpv(comm, 0)));
|
||||
|
||||
/* common fields other than pid can be accessed via xsub fns */
|
||||
|
||||
for (field = event->format.fields; field; field = field->next) {
|
||||
if (field->flags & FIELD_IS_STRING) {
|
||||
int offset;
|
||||
if (field->flags & FIELD_IS_DYNAMIC) {
|
||||
offset = *(int *)(data + field->offset);
|
||||
offset &= 0xffff;
|
||||
} else
|
||||
offset = field->offset;
|
||||
XPUSHs(sv_2mortal(newSVpv((char *)data + offset, 0)));
|
||||
} else { /* FIELD_IS_NUMERIC */
|
||||
val = read_size(data + field->offset, field->size);
|
||||
if (field->flags & FIELD_IS_SIGNED) {
|
||||
XPUSHs(sv_2mortal(newSViv(val)));
|
||||
} else {
|
||||
XPUSHs(sv_2mortal(newSVuv(val)));
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
PUTBACK;
|
||||
|
||||
if (get_cv(handler, 0))
|
||||
call_pv(handler, G_SCALAR);
|
||||
else if (get_cv("main::trace_unhandled", 0)) {
|
||||
XPUSHs(sv_2mortal(newSVpv(handler, 0)));
|
||||
XPUSHs(sv_2mortal(newSViv(PTR2IV(scripting_context))));
|
||||
XPUSHs(sv_2mortal(newSVuv(cpu)));
|
||||
XPUSHs(sv_2mortal(newSVuv(nsecs)));
|
||||
XPUSHs(sv_2mortal(newSViv(pid)));
|
||||
XPUSHs(sv_2mortal(newSVpv(comm, 0)));
|
||||
call_pv("main::trace_unhandled", G_SCALAR);
|
||||
}
|
||||
SPAGAIN;
|
||||
PUTBACK;
|
||||
FREETMPS;
|
||||
LEAVE;
|
||||
}
|
||||
|
||||
static void run_start_sub(void)
|
||||
{
|
||||
dSP; /* access to Perl stack */
|
||||
PUSHMARK(SP);
|
||||
|
||||
if (get_cv("main::trace_begin", 0))
|
||||
call_pv("main::trace_begin", G_DISCARD | G_NOARGS);
|
||||
}
|
||||
|
||||
/*
|
||||
* Start trace script
|
||||
*/
|
||||
static int perl_start_script(const char *script)
|
||||
{
|
||||
const char *command_line[2] = { "", NULL };
|
||||
|
||||
command_line[1] = script;
|
||||
|
||||
my_perl = perl_alloc();
|
||||
perl_construct(my_perl);
|
||||
|
||||
if (perl_parse(my_perl, xs_init, 2, (char **)command_line,
|
||||
(char **)NULL))
|
||||
return -1;
|
||||
|
||||
perl_run(my_perl);
|
||||
if (SvTRUE(ERRSV))
|
||||
return -1;
|
||||
|
||||
run_start_sub();
|
||||
|
||||
fprintf(stderr, "perf trace started with Perl script %s\n\n", script);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
/*
|
||||
* Stop trace script
|
||||
*/
|
||||
static int perl_stop_script(void)
|
||||
{
|
||||
dSP; /* access to Perl stack */
|
||||
PUSHMARK(SP);
|
||||
|
||||
if (get_cv("main::trace_end", 0))
|
||||
call_pv("main::trace_end", G_DISCARD | G_NOARGS);
|
||||
|
||||
perl_destruct(my_perl);
|
||||
perl_free(my_perl);
|
||||
|
||||
fprintf(stderr, "\nperf trace Perl script stopped\n");
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
static int perl_generate_script(const char *outfile)
|
||||
{
|
||||
struct event *event = NULL;
|
||||
struct format_field *f;
|
||||
char fname[PATH_MAX];
|
||||
int not_first, count;
|
||||
FILE *ofp;
|
||||
|
||||
sprintf(fname, "%s.pl", outfile);
|
||||
ofp = fopen(fname, "w");
|
||||
if (ofp == NULL) {
|
||||
fprintf(stderr, "couldn't open %s\n", fname);
|
||||
return -1;
|
||||
}
|
||||
|
||||
fprintf(ofp, "# perf trace event handlers, "
|
||||
"generated by perf trace -g perl\n");
|
||||
|
||||
fprintf(ofp, "# Licensed under the terms of the GNU GPL"
|
||||
" License version 2\n\n");
|
||||
|
||||
fprintf(ofp, "# The common_* event handler fields are the most useful "
|
||||
"fields common to\n");
|
||||
|
||||
fprintf(ofp, "# all events. They don't necessarily correspond to "
|
||||
"the 'common_*' fields\n");
|
||||
|
||||
fprintf(ofp, "# in the format files. Those fields not available as "
|
||||
"handler params can\n");
|
||||
|
||||
fprintf(ofp, "# be retrieved using Perl functions of the form "
|
||||
"common_*($context).\n");
|
||||
|
||||
fprintf(ofp, "# See Context.pm for the list of available "
|
||||
"functions.\n\n");
|
||||
|
||||
fprintf(ofp, "use lib \"$ENV{'PERF_EXEC_PATH'}/scripts/perl/"
|
||||
"Perf-Trace-Util/lib\";\n");
|
||||
|
||||
fprintf(ofp, "use lib \"./Perf-Trace-Util/lib\";\n");
|
||||
fprintf(ofp, "use Perf::Trace::Core;\n");
|
||||
fprintf(ofp, "use Perf::Trace::Context;\n");
|
||||
fprintf(ofp, "use Perf::Trace::Util;\n\n");
|
||||
|
||||
fprintf(ofp, "sub trace_begin\n{\n\t# optional\n}\n\n");
|
||||
fprintf(ofp, "sub trace_end\n{\n\t# optional\n}\n\n");
|
||||
|
||||
while ((event = trace_find_next_event(event))) {
|
||||
fprintf(ofp, "sub %s::%s\n{\n", event->system, event->name);
|
||||
fprintf(ofp, "\tmy (");
|
||||
|
||||
fprintf(ofp, "$event_name, ");
|
||||
fprintf(ofp, "$context, ");
|
||||
fprintf(ofp, "$common_cpu, ");
|
||||
fprintf(ofp, "$common_secs, ");
|
||||
fprintf(ofp, "$common_nsecs,\n");
|
||||
fprintf(ofp, "\t $common_pid, ");
|
||||
fprintf(ofp, "$common_comm,\n\t ");
|
||||
|
||||
not_first = 0;
|
||||
count = 0;
|
||||
|
||||
for (f = event->format.fields; f; f = f->next) {
|
||||
if (not_first++)
|
||||
fprintf(ofp, ", ");
|
||||
if (++count % 5 == 0)
|
||||
fprintf(ofp, "\n\t ");
|
||||
|
||||
fprintf(ofp, "$%s", f->name);
|
||||
}
|
||||
fprintf(ofp, ") = @_;\n\n");
|
||||
|
||||
fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
|
||||
"$common_secs, $common_nsecs,\n\t "
|
||||
"$common_pid, $common_comm);\n\n");
|
||||
|
||||
fprintf(ofp, "\tprintf(\"");
|
||||
|
||||
not_first = 0;
|
||||
count = 0;
|
||||
|
||||
for (f = event->format.fields; f; f = f->next) {
|
||||
if (not_first++)
|
||||
fprintf(ofp, ", ");
|
||||
if (count && count % 4 == 0) {
|
||||
fprintf(ofp, "\".\n\t \"");
|
||||
}
|
||||
count++;
|
||||
|
||||
fprintf(ofp, "%s=", f->name);
|
||||
if (f->flags & FIELD_IS_STRING ||
|
||||
f->flags & FIELD_IS_FLAG ||
|
||||
f->flags & FIELD_IS_SYMBOLIC)
|
||||
fprintf(ofp, "%%s");
|
||||
else if (f->flags & FIELD_IS_SIGNED)
|
||||
fprintf(ofp, "%%d");
|
||||
else
|
||||
fprintf(ofp, "%%u");
|
||||
}
|
||||
|
||||
fprintf(ofp, "\\n\",\n\t ");
|
||||
|
||||
not_first = 0;
|
||||
count = 0;
|
||||
|
||||
for (f = event->format.fields; f; f = f->next) {
|
||||
if (not_first++)
|
||||
fprintf(ofp, ", ");
|
||||
|
||||
if (++count % 5 == 0)
|
||||
fprintf(ofp, "\n\t ");
|
||||
|
||||
if (f->flags & FIELD_IS_FLAG) {
|
||||
if ((count - 1) % 5 != 0) {
|
||||
fprintf(ofp, "\n\t ");
|
||||
count = 4;
|
||||
}
|
||||
fprintf(ofp, "flag_str(\"");
|
||||
fprintf(ofp, "%s::%s\", ", event->system,
|
||||
event->name);
|
||||
fprintf(ofp, "\"%s\", $%s)", f->name,
|
||||
f->name);
|
||||
} else if (f->flags & FIELD_IS_SYMBOLIC) {
|
||||
if ((count - 1) % 5 != 0) {
|
||||
fprintf(ofp, "\n\t ");
|
||||
count = 4;
|
||||
}
|
||||
fprintf(ofp, "symbol_str(\"");
|
||||
fprintf(ofp, "%s::%s\", ", event->system,
|
||||
event->name);
|
||||
fprintf(ofp, "\"%s\", $%s)", f->name,
|
||||
f->name);
|
||||
} else
|
||||
fprintf(ofp, "$%s", f->name);
|
||||
}
|
||||
|
||||
fprintf(ofp, ");\n");
|
||||
fprintf(ofp, "}\n\n");
|
||||
}
|
||||
|
||||
fprintf(ofp, "sub trace_unhandled\n{\n\tmy ($event_name, $context, "
|
||||
"$common_cpu, $common_secs, $common_nsecs,\n\t "
|
||||
"$common_pid, $common_comm) = @_;\n\n");
|
||||
|
||||
fprintf(ofp, "\tprint_header($event_name, $common_cpu, "
|
||||
"$common_secs, $common_nsecs,\n\t $common_pid, "
|
||||
"$common_comm);\n}\n\n");
|
||||
|
||||
fprintf(ofp, "sub print_header\n{\n"
|
||||
"\tmy ($event_name, $cpu, $secs, $nsecs, $pid, $comm) = @_;\n\n"
|
||||
"\tprintf(\"%%-20s %%5u %%05u.%%09u %%8u %%-20s \",\n\t "
|
||||
"$event_name, $cpu, $secs, $nsecs, $pid, $comm);\n}");
|
||||
|
||||
fclose(ofp);
|
||||
|
||||
fprintf(stderr, "generated Perl script: %s\n", fname);
|
||||
|
||||
return 0;
|
||||
}
|
||||
|
||||
struct scripting_ops perl_scripting_ops = {
|
||||
.name = "Perl",
|
||||
.start_script = perl_start_script,
|
||||
.stop_script = perl_stop_script,
|
||||
.process_event = perl_process_event,
|
||||
.generate_script = perl_generate_script,
|
||||
};
|
||||
|
||||
#ifdef NO_LIBPERL
|
||||
void setup_perl_scripting(void)
|
||||
{
|
||||
fprintf(stderr, "Perl scripting not supported."
|
||||
" Install libperl and rebuild perf to enable it. e.g. "
|
||||
"apt-get install libperl-dev (ubuntu), yum install "
|
||||
"perl-ExtUtils-Embed (Fedora), etc.\n");
|
||||
}
|
||||
#else
|
||||
void setup_perl_scripting(void)
|
||||
{
|
||||
int err;
|
||||
err = script_spec_register("Perl", &perl_scripting_ops);
|
||||
if (err)
|
||||
die("error registering Perl script extension");
|
||||
|
||||
err = script_spec_register("pl", &perl_scripting_ops);
|
||||
if (err)
|
||||
die("error registering pl script extension");
|
||||
|
||||
scripting_context = malloc(sizeof(struct scripting_context));
|
||||
}
|
||||
#endif
|
||||
|
|
@ -0,0 +1,51 @@
|
|||
#ifndef __PERF_TRACE_EVENT_PERL_H
|
||||
#define __PERF_TRACE_EVENT_PERL_H
|
||||
#ifdef NO_LIBPERL
|
||||
typedef int INTERP;
|
||||
#define dSP
|
||||
#define ENTER
|
||||
#define SAVETMPS
|
||||
#define PUTBACK
|
||||
#define SPAGAIN
|
||||
#define FREETMPS
|
||||
#define LEAVE
|
||||
#define SP
|
||||
#define ERRSV
|
||||
#define G_SCALAR (0)
|
||||
#define G_DISCARD (0)
|
||||
#define G_NOARGS (0)
|
||||
#define PUSHMARK(a)
|
||||
#define SvTRUE(a) (0)
|
||||
#define XPUSHs(s)
|
||||
#define sv_2mortal(a)
|
||||
#define newSVpv(a,b)
|
||||
#define newSVuv(a)
|
||||
#define newSViv(a)
|
||||
#define get_cv(a,b) (0)
|
||||
#define call_pv(a,b) (0)
|
||||
#define perl_alloc() (0)
|
||||
#define perl_construct(a) (0)
|
||||
#define perl_parse(a,b,c,d,e) (0)
|
||||
#define perl_run(a) (0)
|
||||
#define perl_destruct(a) (0)
|
||||
#define perl_free(a) (0)
|
||||
#define pTHX void
|
||||
#define CV void
|
||||
#define dXSUB_SYS
|
||||
#define pTHX_
|
||||
static inline void newXS(const char *a, void *b, const char *c) {}
|
||||
#else
|
||||
#include <EXTERN.h>
|
||||
#include <perl.h>
|
||||
typedef PerlInterpreter * INTERP;
|
||||
#endif
|
||||
|
||||
struct scripting_context {
|
||||
void *event_data;
|
||||
};
|
||||
|
||||
int common_pc(struct scripting_context *context);
|
||||
int common_flags(struct scripting_context *context);
|
||||
int common_lock_depth(struct scripting_context *context);
|
||||
|
||||
#endif /* __PERF_TRACE_EVENT_PERL_H */
|
||||
|
|
@ -29,6 +29,8 @@ enum format_flags {
|
|||
FIELD_IS_SIGNED = 4,
|
||||
FIELD_IS_STRING = 8,
|
||||
FIELD_IS_DYNAMIC = 16,
|
||||
FIELD_IS_FLAG = 32,
|
||||
FIELD_IS_SYMBOLIC = 64,
|
||||
};
|
||||
|
||||
struct format_field {
|
||||
|
|
@ -243,10 +245,17 @@ extern int latency_format;
|
|||
|
||||
int parse_header_page(char *buf, unsigned long size);
|
||||
int trace_parse_common_type(void *data);
|
||||
int trace_parse_common_pid(void *data);
|
||||
int parse_common_pc(void *data);
|
||||
int parse_common_flags(void *data);
|
||||
int parse_common_lock_depth(void *data);
|
||||
struct event *trace_find_event(int id);
|
||||
struct event *trace_find_next_event(struct event *event);
|
||||
unsigned long long read_size(void *ptr, int size);
|
||||
unsigned long long
|
||||
raw_field_value(struct event *event, const char *name, void *data);
|
||||
void *raw_field_ptr(struct event *event, const char *name, void *data);
|
||||
unsigned long long eval_flag(const char *flag);
|
||||
|
||||
int read_tracing_data(int fd, struct perf_event_attr *pattrs, int nb_events);
|
||||
|
||||
|
|
@ -259,4 +268,18 @@ enum trace_flag_type {
|
|||
TRACE_FLAG_SOFTIRQ = 0x10,
|
||||
};
|
||||
|
||||
struct scripting_ops {
|
||||
const char *name;
|
||||
int (*start_script) (const char *);
|
||||
int (*stop_script) (void);
|
||||
void (*process_event) (int cpu, void *data, int size,
|
||||
unsigned long long nsecs, char *comm);
|
||||
int (*generate_script) (const char *outfile);
|
||||
};
|
||||
|
||||
int script_spec_register(const char *spec, struct scripting_ops *ops);
|
||||
|
||||
extern struct scripting_ops perl_scripting_ops;
|
||||
void setup_perl_scripting(void);
|
||||
|
||||
#endif /* __PERF_TRACE_EVENTS_H */
|
||||
|
|
|
|||
Loading…
Reference in New Issue