AuxXxilium/linux_dsm_epyc7002
1
0
Fork 0
mirror of https://github.com/AuxXxilium/linux_dsm_epyc7002.git synced 2024-11-24 13:20:52 +07:00
Code Issues Actions Packages Projects Releases Wiki Activity

Merge branch 'perf/scripting' into perf/core

Browse Source 
Merge reason: it's ready for v2.6.33.

Signed-off-by: Ingo Molnar <mingo@elte.hu>
This commit is contained in:
Ingo Molnar 2009-12-03 20:10:35 +01:00
commit 23ba90e328
31 changed files with 2458 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

219
tools/perf/Documentation/perf-trace-perl.txt Normal file
View File

@ -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]

11
tools/perf/Documentation/perf-trace.txt
View File

@ -20,6 +20,15 @@ OPTIONS
--dump-raw-trace=:: --dump-raw-trace=::
Display verbose dump of the trace data. 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 SEE ALSO
-------- --------
linkperf:perf-record[1] linkperf:perf-record[1], linkperf:perf-trace-perl[1]

26
tools/perf/Makefile
View File

@ -409,6 +409,7 @@ LIB_OBJS += util/thread.o
LIB_OBJS += util/trace-event-parse.o LIB_OBJS += util/trace-event-parse.o
LIB_OBJS += util/trace-event-read.o LIB_OBJS += util/trace-event-read.o
LIB_OBJS += util/trace-event-info.o LIB_OBJS += util/trace-event-info.o
LIB_OBJS += util/trace-event-perl.o
LIB_OBJS += util/svghelper.o LIB_OBJS += util/svghelper.o
LIB_OBJS += util/sort.o LIB_OBJS += util/sort.o
LIB_OBJS += util/hist.o LIB_OBJS += util/hist.o
@ -491,6 +492,16 @@ else
LIB_OBJS += util/probe-finder.o LIB_OBJS += util/probe-finder.o
endif 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 ifdef NO_DEMANGLE
BASIC_CFLAGS += -DNO_DEMANGLE BASIC_CFLAGS += -DNO_DEMANGLE
else 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 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)"' $< $(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) perf-%$X: %.o $(PERFLIBS)
$(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS) $(QUIET_LINK)$(CC) $(ALL_CFLAGS) -o $@ $(ALL_LDFLAGS) $(filter %.o,$^) $(LIBS)
@ -969,6 +986,13 @@ export perfexec_instdir
install: all install: all
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)' $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(bindir_SQ)'
$(INSTALL) perf$X '$(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 ifdef BUILT_INS
$(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' $(INSTALL) -d -m 755 '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
$(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)' $(INSTALL) $(BUILT_INS) '$(DESTDIR_SQ)$(perfexec_instdir_SQ)'
@ -1054,7 +1078,7 @@ distclean: clean
# $(RM) configure # $(RM) configure
clean: clean:
$(RM) *.o */*.o $(LIB_FILE) $(RM) *.o */*.o */*/*.o */*/*/*.o $(LIB_FILE)
$(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X $(RM) $(ALL_PROGRAMS) $(BUILT_INS) perf$X
$(RM) $(TEST_PROGRAMS) $(RM) $(TEST_PROGRAMS)
$(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope* $(RM) *.spec *.pyc *.pyo */*.pyc */*.pyo common-cmds.h TAGS tags cscope*

259
tools/perf/builtin-trace.c
View File

@ -5,6 +5,50 @@
#include "util/symbol.h" #include "util/symbol.h"
#include "util/thread.h" #include "util/thread.h"
#include "util/header.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" #include "util/parse-options.h"
@ -13,11 +57,12 @@
#include "util/trace-event.h" #include "util/trace-event.h"
#include "util/data_map.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 struct perf_header *header;
static u64 sample_type; static u64 sample_type;
static int process_sample_event(event_t *event) 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 * field, although it should be the same than this perf
* event pid * 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; event__stats.total += period;
@ -105,6 +151,154 @@ static int __cmd_trace(void)
0, 0, &event__cwdlen, &event__cwd); 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[] = { static const char * const annotate_usage[] = {
"perf trace [<options>] <command>", "perf trace [<options>] <command>",
NULL NULL
@ -117,13 +311,23 @@ static const struct option options[] = {
"be more verbose (show symbol address, etc)"), "be more verbose (show symbol address, etc)"),
OPT_BOOLEAN('l', "latency", &latency_format, OPT_BOOLEAN('l', "latency", &latency_format,
"show latency attributes (irqs/preemption disabled, etc)"), "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() OPT_END()
}; };
int cmd_trace(int argc, const char **argv, const char *prefix __used) int cmd_trace(int argc, const char **argv, const char *prefix __used)
{ {
int err;
symbol__init(0); symbol__init(0);
setup_scripting();
argc = parse_options(argc, argv, options, annotate_usage, 0); argc = parse_options(argc, argv, options, annotate_usage, 0);
if (argc) { if (argc) {
/* /*
@ -136,5 +340,50 @@ int cmd_trace(int argc, const char **argv, const char *prefix __used)
setup_pager(); 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;
} }

134
tools/perf/scripts/perl/Perf-Trace-Util/Context.c Normal file
View File

@ -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;
}

41
tools/perf/scripts/perl/Perf-Trace-Util/Context.xs Normal file
View File

@ -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

17
tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL Normal file
View File

@ -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
);

59
tools/perf/scripts/perl/Perf-Trace-Util/README Normal file
View File

@ -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.

55
tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Context.pm Normal file
View File

@ -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

192
tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Core.pm Normal file
View File

@ -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

88
tools/perf/scripts/perl/Perf-Trace-Util/lib/Perf/Trace/Util.pm Normal file
View File

@ -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

1
tools/perf/scripts/perl/Perf-Trace-Util/typemap Normal file
View File

@ -0,0 +1 @@
struct scripting_context * T_PTR

7
tools/perf/scripts/perl/bin/check-perf-trace-record Normal file
View File

@ -0,0 +1,7 @@
#!/bin/bash
perf record -c 1 -f -a -M -R -e kmem:kmalloc -e irq:softirq_entry

5
tools/perf/scripts/perl/bin/check-perf-trace-report Normal file
View File

@ -0,0 +1,5 @@
#!/bin/bash
perf trace -s ~/libexec/perf-core/scripts/perl/check-perf-trace.pl

2
tools/perf/scripts/perl/bin/rw-by-file-record Normal file
View File

@ -0,0 +1,2 @@
#!/bin/bash
perf record -c 1 -f -a -M -R -e syscalls:sys_enter_read -e syscalls:sys_enter_write

5
tools/perf/scripts/perl/bin/rw-by-file-report Normal file
View File

@ -0,0 +1,5 @@
#!/bin/bash
perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-file.pl

2
tools/perf/scripts/perl/bin/rw-by-pid-record Normal file
View File

@ -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

5
tools/perf/scripts/perl/bin/rw-by-pid-report Normal file
View File

@ -0,0 +1,5 @@
#!/bin/bash
perf trace -s ~/libexec/perf-core/scripts/perl/rw-by-pid.pl

6
tools/perf/scripts/perl/bin/wakeup-latency-record Normal file
View File

@ -0,0 +1,6 @@
#!/bin/bash
perf record -c 1 -f -a -M -R -e sched:sched_switch -e sched:sched_wakeup

5
tools/perf/scripts/perl/bin/wakeup-latency-report Normal file
View File

@ -0,0 +1,5 @@
#!/bin/bash
perf trace -s ~/libexec/perf-core/scripts/perl/wakeup-latency.pl

2
tools/perf/scripts/perl/bin/workqueue-stats-record Normal file
View File

@ -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

6
tools/perf/scripts/perl/bin/workqueue-stats-report Normal file
View File

@ -0,0 +1,6 @@
#!/bin/bash
perf trace -s ~/libexec/perf-core/scripts/perl/workqueue-stats.pl

106
tools/perf/scripts/perl/check-perf-trace.pl Normal file
View File

@ -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);
}

105
tools/perf/scripts/perl/rw-by-file.pl Normal file
View File

@ -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}++;
}

170
tools/perf/scripts/perl/rw-by-pid.pl Normal file
View File

@ -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}++;
}

103
tools/perf/scripts/perl/wakeup-latency.pl Normal file
View File

@ -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}++;
}

129
tools/perf/scripts/perl/workqueue-stats.pl Normal file
View File

@ -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}++;
}

41
tools/perf/util/trace-event-parse.c
View File

@ -48,6 +48,11 @@ static unsigned long long input_buf_siz;
static int cpus; static int cpus;
static int long_size; 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) 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->type = PRINT_FIELD;
arg->field.name = 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); type = read_token(&token);
*tok = token; *tok = token;
@ -1668,9 +1683,11 @@ process_arg_token(struct event *event, struct print_arg *arg,
type = process_entry(event, arg, &token); type = process_entry(event, arg, &token);
} else if (strcmp(token, "__print_flags") == 0) { } else if (strcmp(token, "__print_flags") == 0) {
free_token(token); free_token(token);
is_flag_field = 1;
type = process_flags(event, arg, &token); type = process_flags(event, arg, &token);
} else if (strcmp(token, "__print_symbolic") == 0) { } else if (strcmp(token, "__print_symbolic") == 0) {
free_token(token); free_token(token);
is_symbolic_field = 1;
type = process_symbols(event, arg, &token); type = process_symbols(event, arg, &token);
} else if (strcmp(token, "__get_str") == 0) { } else if (strcmp(token, "__get_str") == 0) {
free_token(token); free_token(token);
@ -1871,7 +1888,7 @@ find_any_field(struct event *event, const char *name)
return find_field(event, 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) { switch (size) {
case 1: case 1:
@ -1956,7 +1973,7 @@ int trace_parse_common_type(void *data)
"common_type"); "common_type");
} }
static int parse_common_pid(void *data) int trace_parse_common_pid(void *data)
{ {
static int pid_offset; static int pid_offset;
static int pid_size; static int pid_size;
@ -1965,7 +1982,7 @@ static int parse_common_pid(void *data)
"common_pid"); "common_pid");
} }
static int parse_common_pc(void *data) int parse_common_pc(void *data)
{ {
static int pc_offset; static int pc_offset;
static int pc_size; static int pc_size;
@ -1974,7 +1991,7 @@ static int parse_common_pc(void *data)
"common_preempt_count"); "common_preempt_count");
} }
static int parse_common_flags(void *data) int parse_common_flags(void *data)
{ {
static int flags_offset; static int flags_offset;
static int flags_size; static int flags_size;
@ -1983,7 +2000,7 @@ static int parse_common_flags(void *data)
"common_flags"); "common_flags");
} }
static int parse_common_lock_depth(void *data) int parse_common_lock_depth(void *data)
{ {
static int ld_offset; static int ld_offset;
static int ld_size; static int ld_size;
@ -2008,6 +2025,14 @@ struct event *trace_find_event(int id)
return event; 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, static unsigned long long eval_num_arg(void *data, int size,
struct event *event, struct print_arg *arg) struct event *event, struct print_arg *arg)
{ {
@ -2147,7 +2172,7 @@ static const struct flag flags[] = {
{ "HRTIMER_RESTART", 1 }, { "HRTIMER_RESTART", 1 },
}; };
static unsigned long long eval_flag(const char *flag) unsigned long long eval_flag(const char *flag)
{ {
int i; 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)) if (!(event->flags & EVENT_FL_ISFUNCRET))
return NULL; return NULL;
pid = parse_common_pid(next->data); pid = trace_parse_common_pid(next->data);
field = find_field(event, "func"); field = find_field(event, "func");
if (!field) if (!field)
die("function return does not have field func"); 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; return;
} }
pid = parse_common_pid(data); pid = trace_parse_common_pid(data);
if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET)) if (event->flags & (EVENT_FL_ISFUNCENT | EVENT_FL_ISFUNCRET))
return pretty_print_func_graph(data, size, event, cpu, return pretty_print_func_graph(data, size, event, cpu,

598
tools/perf/util/trace-event-perl.c Normal file
View File

@ -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

51
tools/perf/util/trace-event-perl.h Normal file
View File

@ -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 */

23
tools/perf/util/trace-event.h
View File

@ -29,6 +29,8 @@ enum format_flags {
FIELD_IS_SIGNED = 4, FIELD_IS_SIGNED = 4,
FIELD_IS_STRING = 8, FIELD_IS_STRING = 8,
FIELD_IS_DYNAMIC = 16, FIELD_IS_DYNAMIC = 16,
FIELD_IS_FLAG = 32,
FIELD_IS_SYMBOLIC = 64,
}; };
struct format_field { struct format_field {
@ -243,10 +245,17 @@ extern int latency_format;
int parse_header_page(char *buf, unsigned long size); int parse_header_page(char *buf, unsigned long size);
int trace_parse_common_type(void *data); 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_event(int id);
struct event *trace_find_next_event(struct event *event);
unsigned long long read_size(void *ptr, int size);
unsigned long long unsigned long long
raw_field_value(struct event *event, const char *name, void *data); raw_field_value(struct event *event, const char *name, void *data);
void *raw_field_ptr(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); 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, 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 */ #endif /* __PERF_TRACE_EVENTS_H */