Commit d1b93772 authored by Tom Zanussi's avatar Tom Zanussi Committed by Ingo Molnar
Browse files

perf trace: Add interface to access perf data from Perl handlers 



The Perl scripting support for perf trace allows most of a trace
event's data to be accessed directly as handler arguments, but
not all of it e.g. the less common fields aren't passed in.  To
give scripts access to the other fields and/or any other data or
metadata in the main perf executable that might be useful, a way
to access the C data in perf from Perl is needed; this patch
uses the Perl XS facility to do it for the common_xxx event
fields not passed to handler functions.

Context.pm exports three functions to Perl scripts that access
fields for the current event by calling back into perf:
common_pc(), common_flags() and common_lock_depth().  Support
for common_flags() field values was added to Core.pm and a
script used to sanity check these and other basic scripting
features, check-perf-trace.pl, was also added.

Signed-off-by: default avatarTom Zanussi <tzanussi@gmail.com>
Cc: fweisbec@gmail.com
Cc: rostedt@goodmis.org
Cc: anton@samba.org
Cc: hch@infradead.org
LKML-Reference: <1259133352-23685-6-git-send-email-tzanussi@gmail.com>
Signed-off-by: default avatarIngo Molnar <mingo@elte.hu>
parent bcefe12e

tools/perf/Makefile

+5 −1
Original line number Diff line number Diff line
@@ -497,6 +497,7 @@ ifneq ($(shell sh -c "(echo '\#include <EXTERN.h>'; echo '\#include <perl.h>'; e 
	BASIC_CFLAGS += -DNO_LIBPERL

else

	ALL_LDFLAGS += $(PERL_EMBED_LDOPTS)

	LIB_OBJS += scripts/perl/Perf-Trace-Util/Context.o

endif



ifdef NO_DEMANGLE
@@ -873,6 +874,9 @@ util/find_next_bit.o: ../../lib/find_next_bit.c PERF-CFLAGS 
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 $<



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)
@@ -1072,7 +1076,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*

tools/perf/scripts/perl/Perf-Trace-Util/Context.c

0 → 100644
+134 −0
Original line number Diff line number Diff line 
/*

 * 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_get_common_pc); /* prototype to pass -Wmissing-prototypes */

XS(XS_Perf__Trace__Context_get_common_pc)

{

#ifdef dVAR

    dVAR; dXSARGS;

#else

    dXSARGS;

#endif

    if (items != 1)

       Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_pc", "context");

    PERL_UNUSED_VAR(cv); /* -W */

    {

	struct scripting_context *	context = INT2PTR(struct scripting_context *,SvIV(ST(0)));

	int	RETVAL;

	dXSTARG;



	RETVAL = get_common_pc(context);

	XSprePUSH; PUSHi((IV)RETVAL);

    }

    XSRETURN(1);

}





XS(XS_Perf__Trace__Context_get_common_flags); /* prototype to pass -Wmissing-prototypes */

XS(XS_Perf__Trace__Context_get_common_flags)

{

#ifdef dVAR

    dVAR; dXSARGS;

#else

    dXSARGS;

#endif

    if (items != 1)

       Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_flags", "context");

    PERL_UNUSED_VAR(cv); /* -W */

    {

	struct scripting_context *	context = INT2PTR(struct scripting_context *,SvIV(ST(0)));

	int	RETVAL;

	dXSTARG;



	RETVAL = get_common_flags(context);

	XSprePUSH; PUSHi((IV)RETVAL);

    }

    XSRETURN(1);

}





XS(XS_Perf__Trace__Context_get_common_lock_depth); /* prototype to pass -Wmissing-prototypes */

XS(XS_Perf__Trace__Context_get_common_lock_depth)

{

#ifdef dVAR

    dVAR; dXSARGS;

#else

    dXSARGS;

#endif

    if (items != 1)

       Perl_croak(aTHX_ "Usage: %s(%s)", "Perf::Trace::Context::get_common_lock_depth", "context");

    PERL_UNUSED_VAR(cv); /* -W */

    {

	struct scripting_context *	context = INT2PTR(struct scripting_context *,SvIV(ST(0)));

	int	RETVAL;

	dXSTARG;



	RETVAL = get_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::get_common_pc", XS_Perf__Trace__Context_get_common_pc, file, "$");

        newXSproto("Perf::Trace::Context::get_common_flags", XS_Perf__Trace__Context_get_common_flags, file, "$");

        newXSproto("Perf::Trace::Context::get_common_lock_depth", XS_Perf__Trace__Context_get_common_lock_depth, file, "$");

    if (PL_unitcheckav)

         call_list(PL_scopestack_ix, PL_unitcheckav);

    XSRETURN_YES;

}

tools/perf/scripts/perl/Perf-Trace-Util/Context.xs

0 → 100644
+41 −0
Original line number Diff line number Diff line 
/*

 * 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

get_common_pc(context)

	struct scripting_context * context



int

get_common_flags(context)

	struct scripting_context * context



int

get_common_lock_depth(context)

	struct scripting_context * context

tools/perf/scripts/perl/Perf-Trace-Util/Makefile.PL

+8 −3
Original line number Diff line number Diff line
@@ -3,10 +3,15 @@ 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::Util',

    VERSION_FROM      => 'lib/Perf/Trace/Util.pm', # finds $VERSION

    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/Util.pm', # retrieve abstract from module

      (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

);

tools/perf/scripts/perl/Perf-Trace-Util/README

+29 −5
Original line number Diff line number Diff line
@@ -3,6 +3,34 @@ 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
@@ -15,12 +43,10 @@ DEPENDENCIES 


This module requires these other modules and libraries:



  blah blah blah

  None



COPYRIGHT AND LICENCE



Put the correct copyright and licence information here.



Copyright (C) 2009 by Tom Zanussi <tzanussi@gmail.com>



This library is free software; you can redistribute it and/or modify
@@ -31,5 +57,3 @@ 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.

CRA Git | Maintained and supported by SUSTech CRA and CCSE