mirror/perl
1
0
Fork 0
mirror of https://github.com/Perl/perl5.git synced 2026-01-26 08:38:23 +00:00
Code Issues Packages Projects Releases Wiki Activity

rename and function-ise dtrace macros

Browse Source 
This commit:

1. Renames the various dtrace probe macros into a consistent and
self-documenting pattern, e.g.

ENTRY_PROBE  => PERL_DTRACE_PROBE_ENTRY
RETURN_PROBE => PERL_DTRACE_PROBE_RETURN

Since they're supposed to be defined only under PERL_CORE, this shouldn't
break anything that's not being naughty.

2. Implement the main body of these macros using a real function.

They were formerly defined along the lines of

    if (PERL_SUB_ENTRY_ENABLED())
        PERL_SUB_ENTRY(...);

The PERL_SUB_ENTRY() part is a macro generated by the dtrace system, which
for example on linux expands to a large bunch of assembly directives.
Replace the direct macro with a function wrapper, e.g.

    if (PERL_SUB_ENTRY_ENABLED())
        Perl_dtrace_probe_call(aTHX_ cv, TRUE);

This reduces to once the number of times the macro is expanded.

The new functions also take simpler args and then process the values they
need using intermediate temporary vars to avoid huge macro expansions.

For example

    ENTRY_PROBE(CvNAMED(cv)
                    ? HEK_KEY(CvNAME_HEK(cv))
                    : GvENAME(CvGV(cv)),
                CopFILE((const COP *)CvSTART(cv)),
                CopLINE((const COP *)CvSTART(cv)),
                CopSTASHPV((const COP *)CvSTART(cv)));

is now

    PERL_DTRACE_PROBE_ENTRY(cv);

This reduces the executable size by 1K on -O2 -Dusedtrace builds,
and by 45K on -DDEBUGGING -Dusedtrace builds.
This commit is contained in:
David Mitchell 2016-02-15 13:48:24 +00:00
parent 5fa8e14416
commit 3f6bd23a1b
10 changed files with 138 additions and 83 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
dump.c
View File

@ -2235,7 +2235,7 @@ Perl_runops_debug(pTHX)
LEAVE;
}
OP_ENTRY_PROBE(OP_NAME(PL_op));
PERL_DTRACE_PROBE_OP(PL_op);
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
PERL_ASYNC_CHECK();

7
embed.fnc
View File

@ -2940,4 +2940,11 @@ AiM |void |cx_pushgiven |NN PERL_CONTEXT *cx|NULLOK SV *orig_defsv
AiM |void |cx_popgiven |NN PERL_CONTEXT *cx
#endif
#ifdef USE_DTRACE
XEop |void |dtrace_probe_call |NN CV *cv|bool is_call
XEop |void |dtrace_probe_load |NN const char *name|bool is_loading
XEop |void |dtrace_probe_op |NN const OP *op
XEop |void |dtrace_probe_phase|enum perl_phase phase
#endif
: ex: set ts=8 sts=4 sw=4 noet:

14
inline.h
View File

@ -480,12 +480,7 @@ S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
PERL_ARGS_ASSERT_CX_PUSHSUB;
ENTRY_PROBE(CvNAMED(cv)
? HEK_KEY(CvNAME_HEK(cv))
: GvENAME(CvGV(cv)),
CopFILE((const COP *)CvSTART(cv)),
CopLINE((const COP *)CvSTART(cv)),
CopSTASHPV((const COP *)CvSTART(cv)));
PERL_DTRACE_PROBE_ENTRY(cv);
cx->blk_sub.cv = cv;
cx->blk_sub.olddepth = CvDEPTH(cv);
cx->blk_sub.prevcomppad = PL_comppad;
@ -545,12 +540,7 @@ S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
PERL_ARGS_ASSERT_CX_POPSUB;
assert(CxTYPE(cx) == CXt_SUB);
RETURN_PROBE(CvNAMED(cx->blk_sub.cv)
? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))
: GvENAME(CvGV(cx->blk_sub.cv)),
CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));
PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv);
if (CxHASARGS(cx))
cx_popsub_args(cx);

9
makedef.pl
View File

@ -427,6 +427,15 @@ unless ($define{'PERL_OP_PARENT'}) {
);
}
unless ($define{'USE_DTRACE'}) {
++$skip{$_} foreach qw(
Perl_dtrace_probe_call
Perl_dtrace_probe_load
Perl_dtrace_probe_op
Perl_dtrace_probe_phase
);
}
if ($define{'NO_MATHOMS'}) {
# win32 builds happen in the win32/ subdirectory, but vms builds happen
# at the top level, so we need to look in two candidate locations for

89
mydtrace.h
View File

@ -13,80 +13,39 @@
# include "perldtrace.h"
# if defined(STAP_PROBE_ADDR) && !defined(DEBUGGING)
# define PERL_DTRACE_PROBE_ENTRY(cv) \
if (PERL_SUB_ENTRY_ENABLED()) \
Perl_dtrace_probe_call(aTHX_ cv, TRUE);
/* SystemTap 1.2 uses a construct that chokes on passing a char array
* as a char *, in this case hek_key in struct hek. Workaround it
* with a temporary.
*/
# define PERL_DTRACE_PROBE_RETURN(cv) \
if (PERL_SUB_ENTRY_ENABLED()) \
Perl_dtrace_probe_call(aTHX_ cv, FALSE);
# define ENTRY_PROBE(func, file, line, stash) \
if (PERL_SUB_ENTRY_ENABLED()) { \
const char *tmp_func = func; \
PERL_SUB_ENTRY(tmp_func, file, line, stash); \
}
# define PERL_DTRACE_PROBE_FILE_LOADING(name) \
if (PERL_SUB_ENTRY_ENABLED()) \
Perl_dtrace_probe_load(aTHX_ name, TRUE);
# define RETURN_PROBE(func, file, line, stash) \
if (PERL_SUB_RETURN_ENABLED()) { \
const char *tmp_func = func; \
PERL_SUB_RETURN(tmp_func, file, line, stash); \
}
# define PERL_DTRACE_PROBE_FILE_LOADED(name) \
if (PERL_SUB_ENTRY_ENABLED()) \
Perl_dtrace_probe_load(aTHX_ name, FALSE);
# define LOADING_FILE_PROBE(name) \
if (PERL_LOADING_FILE_ENABLED()) { \
const char *tmp_name = name; \
PERL_LOADING_FILE(tmp_name); \
}
# define PERL_DTRACE_PROBE_OP(op) \
if (PERL_OP_ENTRY_ENABLED()) \
Perl_dtrace_probe_op(aTHX_ op);
# define LOADED_FILE_PROBE(name) \
if (PERL_LOADED_FILE_ENABLED()) { \
const char *tmp_name = name; \
PERL_LOADED_FILE(tmp_name); \
}
# else
# define ENTRY_PROBE(func, file, line, stash) \
if (PERL_SUB_ENTRY_ENABLED()) { \
PERL_SUB_ENTRY(func, file, line, stash); \
}
# define RETURN_PROBE(func, file, line, stash) \
if (PERL_SUB_RETURN_ENABLED()) { \
PERL_SUB_RETURN(func, file, line, stash); \
}
# define LOADING_FILE_PROBE(name) \
if (PERL_LOADING_FILE_ENABLED()) { \
PERL_LOADING_FILE(name); \
}
# define LOADED_FILE_PROBE(name) \
if (PERL_LOADED_FILE_ENABLED()) { \
PERL_LOADED_FILE(name); \
}
# endif
# define OP_ENTRY_PROBE(name) \
if (PERL_OP_ENTRY_ENABLED()) { \
PERL_OP_ENTRY(name); \
}
# define PHASE_CHANGE_PROBE(new_phase, old_phase) \
if (PERL_PHASE_CHANGE_ENABLED()) { \
PERL_PHASE_CHANGE(new_phase, old_phase); \
}
# define PERL_DTRACE_PROBE_PHASE(phase) \
if (PERL_OP_ENTRY_ENABLED()) \
Perl_dtrace_probe_phase(aTHX_ phase);
#else
/* NOPs */
# define ENTRY_PROBE(func, file, line, stash)
# define RETURN_PROBE(func, file, line, stash)
# define PHASE_CHANGE_PROBE(new_phase, old_phase)
# define OP_ENTRY_PROBE(name)
# define LOADING_FILE_PROBE(name)
# define LOADED_FILE_PROBE(name)
# define PERL_DTRACE_PROBE_ENTRY(cv)
# define PERL_DTRACE_PROBE_RETURN(cv)
# define PERL_DTRACE_PROBE_FILE_LOADING(cv)
# define PERL_DTRACE_PROBE_FILE_LOADED(cv)
# define PERL_DTRACE_PROBE_OP(op)
# define PERL_DTRACE_PROBE_PHASE(phase)
#endif

2
perl.h
View File

@ -5241,7 +5241,7 @@ EXTCONST char PL_bincompat_options[];
#ifndef PERL_SET_PHASE
# define PERL_SET_PHASE(new_phase) \
PHASE_CHANGE_PROBE(PL_phase_names[new_phase], PL_phase_names[PL_phase]); \
PERL_DTRACE_PROBE_PHASE(new_phase); \
PL_phase = new_phase;
#endif

4
pp_ctl.c
View File

@ -3720,7 +3720,7 @@ PP(pp_require)
}
}
LOADING_FILE_PROBE(unixname);
PERL_DTRACE_PROBE_FILE_LOADING(unixname);
/* prepare to compile file */
@ -4056,7 +4056,7 @@ PP(pp_require)
else
op = PL_op->op_next;
LOADED_FILE_PROBE(unixname);
PERL_DTRACE_PROBE_FILE_LOADED(unixname);
return op;
}

12
proto.h
View File

@ -5494,6 +5494,18 @@ PERL_CALLCONV bool Perl_dump_c_backtrace(pTHX_ PerlIO* fp, int max_depth, int sk
PERL_CALLCONV Perl_c_backtrace* Perl_get_c_backtrace(pTHX_ int max_depth, int skip);
PERL_CALLCONV SV* Perl_get_c_backtrace_dump(pTHX_ int max_depth, int skip);
#endif
#if defined(USE_DTRACE)
PERL_CALLCONV void Perl_dtrace_probe_call(pTHX_ CV *cv, bool is_call);
#define PERL_ARGS_ASSERT_DTRACE_PROBE_CALL \
assert(cv)
PERL_CALLCONV void Perl_dtrace_probe_load(pTHX_ const char *name, bool is_loading);
#define PERL_ARGS_ASSERT_DTRACE_PROBE_LOAD \
assert(name)
PERL_CALLCONV void Perl_dtrace_probe_op(pTHX_ const OP *op);
#define PERL_ARGS_ASSERT_DTRACE_PROBE_OP \
assert(op)
PERL_CALLCONV void Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase);
#endif
#if defined(USE_ITHREADS)
PERL_CALLCONV PADOFFSET Perl_alloccopstash(pTHX_ HV *hv);
#define PERL_ARGS_ASSERT_ALLOCCOPSTASH \

4
run.c
View File

@ -37,9 +37,9 @@ int
Perl_runops_standard(pTHX)
{
OP *op = PL_op;
OP_ENTRY_PROBE(OP_NAME(op));
PERL_DTRACE_PROBE_OP(op);
while ((PL_op = op = op->op_ppaddr(aTHX))) {
OP_ENTRY_PROBE(OP_NAME(op));
PERL_DTRACE_PROBE_OP(op);
}
PERL_ASYNC_CHECK();

78
util.c
View File

@ -6652,6 +6652,84 @@ int perl_tsa_mutex_destroy(perl_mutex* mutex)
#endif
#ifdef USE_DTRACE
/* log a sub call or return */
void
Perl_dtrace_probe_call(pTHX_ CV *cv, bool is_call)
{
const char *func;
const char *file;
const char *stash;
const COP *start;
line_t line;
PERL_ARGS_ASSERT_DTRACE_PROBE_CALL;
if (CvNAMED(cv)) {
HEK *hek = CvNAME_HEK(cv);
func = HEK_KEY(hek);
}
else {
GV *gv = CvGV(cv);
func = GvENAME(gv);
}
start = (const COP *)CvSTART(cv);
file = CopFILE(start);
line = CopLINE(start);
stash = CopSTASHPV(start);
if (is_call) {
PERL_SUB_ENTRY(func, file, line, stash);
}
else {
PERL_SUB_RETURN(func, file, line, stash);
}
}
/* log a require file loading/loaded */
void
Perl_dtrace_probe_load(pTHX_ const char *name, bool is_loading)
{
PERL_ARGS_ASSERT_DTRACE_PROBE_LOAD;
if (is_loading) {
PERL_LOADING_FILE(name);
}
else {
PERL_LOADED_FILE(name);
}
}
/* log an op execution */
void
Perl_dtrace_probe_op(pTHX_ const OP *op)
{
PERL_ARGS_ASSERT_DTRACE_PROBE_OP;
PERL_OP_ENTRY(OP_NAME(op));
}
/* log a compile/run phase change */
void
Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase)
{
const char *ph_old = PL_phase_names[PL_phase];
const char *ph_new = PL_phase_names[phase];
PERL_PHASE_CHANGE(ph_new, ph_old);
}
#endif
/*
* ex: set ts=8 sts=4 sw=4 et:
*/