Skip to content

Commit 3f6bd23

Browse files
iabyniabyn
committedMar 18, 2016
rename and function-ise dtrace macros
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.
·
v5.33.3v5.23.9
1 parent 5fa8e14 commit 3f6bd23

10 files changed

+138
-83
lines changed
 

‎dump.c

+1-1
Original file line numberDiff line numberDiff line change
@@ -2235,7 +2235,7 @@ Perl_runops_debug(pTHX)
22352235
LEAVE;
22362236
}
22372237

2238-
OP_ENTRY_PROBE(OP_NAME(PL_op));
2238+
PERL_DTRACE_PROBE_OP(PL_op);
22392239
} while ((PL_op = PL_op->op_ppaddr(aTHX)));
22402240
DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n"));
22412241
PERL_ASYNC_CHECK();

‎embed.fnc

+7
Original file line numberDiff line numberDiff line change
@@ -2940,4 +2940,11 @@ AiM |void |cx_pushgiven |NN PERL_CONTEXT *cx|NULLOK SV *orig_defsv
29402940
AiM |void |cx_popgiven |NN PERL_CONTEXT *cx
29412941
#endif
29422942

2943+
#ifdef USE_DTRACE
2944+
XEop |void |dtrace_probe_call |NN CV *cv|bool is_call
2945+
XEop |void |dtrace_probe_load |NN const char *name|bool is_loading
2946+
XEop |void |dtrace_probe_op |NN const OP *op
2947+
XEop |void |dtrace_probe_phase|enum perl_phase phase
2948+
#endif
2949+
29432950
: ex: set ts=8 sts=4 sw=4 noet:

‎inline.h

+2-12
Original file line numberDiff line numberDiff line change
@@ -480,12 +480,7 @@ S_cx_pushsub(pTHX_ PERL_CONTEXT *cx, CV *cv, OP *retop, bool hasargs)
480480

481481
PERL_ARGS_ASSERT_CX_PUSHSUB;
482482

483-
ENTRY_PROBE(CvNAMED(cv)
484-
? HEK_KEY(CvNAME_HEK(cv))
485-
: GvENAME(CvGV(cv)),
486-
CopFILE((const COP *)CvSTART(cv)),
487-
CopLINE((const COP *)CvSTART(cv)),
488-
CopSTASHPV((const COP *)CvSTART(cv)));
483+
PERL_DTRACE_PROBE_ENTRY(cv);
489484
cx->blk_sub.cv = cv;
490485
cx->blk_sub.olddepth = CvDEPTH(cv);
491486
cx->blk_sub.prevcomppad = PL_comppad;
@@ -545,12 +540,7 @@ S_cx_popsub(pTHX_ PERL_CONTEXT *cx)
545540
PERL_ARGS_ASSERT_CX_POPSUB;
546541
assert(CxTYPE(cx) == CXt_SUB);
547542

548-
RETURN_PROBE(CvNAMED(cx->blk_sub.cv)
549-
? HEK_KEY(CvNAME_HEK(cx->blk_sub.cv))
550-
: GvENAME(CvGV(cx->blk_sub.cv)),
551-
CopFILE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
552-
CopLINE((COP*)CvSTART((const CV*)cx->blk_sub.cv)),
553-
CopSTASHPV((COP*)CvSTART((const CV*)cx->blk_sub.cv)));
543+
PERL_DTRACE_PROBE_RETURN(cx->blk_sub.cv);
554544

555545
if (CxHASARGS(cx))
556546
cx_popsub_args(cx);

‎makedef.pl

+9
Original file line numberDiff line numberDiff line change
@@ -427,6 +427,15 @@ sub readvar {
427427
);
428428
}
429429

430+
unless ($define{'USE_DTRACE'}) {
431+
++$skip{$_} foreach qw(
432+
Perl_dtrace_probe_call
433+
Perl_dtrace_probe_load
434+
Perl_dtrace_probe_op
435+
Perl_dtrace_probe_phase
436+
);
437+
}
438+
430439
if ($define{'NO_MATHOMS'}) {
431440
# win32 builds happen in the win32/ subdirectory, but vms builds happen
432441
# at the top level, so we need to look in two candidate locations for

‎mydtrace.h

+24-65
Original file line numberDiff line numberDiff line change
@@ -13,80 +13,39 @@
1313

1414
# include "perldtrace.h"
1515

16-
# if defined(STAP_PROBE_ADDR) && !defined(DEBUGGING)
16+
# define PERL_DTRACE_PROBE_ENTRY(cv) \
17+
if (PERL_SUB_ENTRY_ENABLED()) \
18+
Perl_dtrace_probe_call(aTHX_ cv, TRUE);
1719

18-
/* SystemTap 1.2 uses a construct that chokes on passing a char array
19-
* as a char *, in this case hek_key in struct hek. Workaround it
20-
* with a temporary.
21-
*/
22-
23-
# define ENTRY_PROBE(func, file, line, stash) \
24-
if (PERL_SUB_ENTRY_ENABLED()) { \
25-
const char *tmp_func = func; \
26-
PERL_SUB_ENTRY(tmp_func, file, line, stash); \
27-
}
28-
29-
# define RETURN_PROBE(func, file, line, stash) \
30-
if (PERL_SUB_RETURN_ENABLED()) { \
31-
const char *tmp_func = func; \
32-
PERL_SUB_RETURN(tmp_func, file, line, stash); \
33-
}
34-
35-
# define LOADING_FILE_PROBE(name) \
36-
if (PERL_LOADING_FILE_ENABLED()) { \
37-
const char *tmp_name = name; \
38-
PERL_LOADING_FILE(tmp_name); \
39-
}
40-
41-
# define LOADED_FILE_PROBE(name) \
42-
if (PERL_LOADED_FILE_ENABLED()) { \
43-
const char *tmp_name = name; \
44-
PERL_LOADED_FILE(tmp_name); \
45-
}
46-
47-
# else
48-
49-
# define ENTRY_PROBE(func, file, line, stash) \
50-
if (PERL_SUB_ENTRY_ENABLED()) { \
51-
PERL_SUB_ENTRY(func, file, line, stash); \
52-
}
53-
54-
# define RETURN_PROBE(func, file, line, stash) \
55-
if (PERL_SUB_RETURN_ENABLED()) { \
56-
PERL_SUB_RETURN(func, file, line, stash); \
57-
}
58-
59-
# define LOADING_FILE_PROBE(name) \
60-
if (PERL_LOADING_FILE_ENABLED()) { \
61-
PERL_LOADING_FILE(name); \
62-
}
20+
# define PERL_DTRACE_PROBE_RETURN(cv) \
21+
if (PERL_SUB_ENTRY_ENABLED()) \
22+
Perl_dtrace_probe_call(aTHX_ cv, FALSE);
6323

64-
# define LOADED_FILE_PROBE(name) \
65-
if (PERL_LOADED_FILE_ENABLED()) { \
66-
PERL_LOADED_FILE(name); \
67-
}
24+
# define PERL_DTRACE_PROBE_FILE_LOADING(name) \
25+
if (PERL_SUB_ENTRY_ENABLED()) \
26+
Perl_dtrace_probe_load(aTHX_ name, TRUE);
6827

69-
# endif
28+
# define PERL_DTRACE_PROBE_FILE_LOADED(name) \
29+
if (PERL_SUB_ENTRY_ENABLED()) \
30+
Perl_dtrace_probe_load(aTHX_ name, FALSE);
7031

71-
# define OP_ENTRY_PROBE(name) \
72-
if (PERL_OP_ENTRY_ENABLED()) { \
73-
PERL_OP_ENTRY(name); \
74-
}
32+
# define PERL_DTRACE_PROBE_OP(op) \
33+
if (PERL_OP_ENTRY_ENABLED()) \
34+
Perl_dtrace_probe_op(aTHX_ op);
7535

76-
# define PHASE_CHANGE_PROBE(new_phase, old_phase) \
77-
if (PERL_PHASE_CHANGE_ENABLED()) { \
78-
PERL_PHASE_CHANGE(new_phase, old_phase); \
79-
}
36+
# define PERL_DTRACE_PROBE_PHASE(phase) \
37+
if (PERL_OP_ENTRY_ENABLED()) \
38+
Perl_dtrace_probe_phase(aTHX_ phase);
8039

8140
#else
8241

8342
/* NOPs */
84-
# define ENTRY_PROBE(func, file, line, stash)
85-
# define RETURN_PROBE(func, file, line, stash)
86-
# define PHASE_CHANGE_PROBE(new_phase, old_phase)
87-
# define OP_ENTRY_PROBE(name)
88-
# define LOADING_FILE_PROBE(name)
89-
# define LOADED_FILE_PROBE(name)
43+
# define PERL_DTRACE_PROBE_ENTRY(cv)
44+
# define PERL_DTRACE_PROBE_RETURN(cv)
45+
# define PERL_DTRACE_PROBE_FILE_LOADING(cv)
46+
# define PERL_DTRACE_PROBE_FILE_LOADED(cv)
47+
# define PERL_DTRACE_PROBE_OP(op)
48+
# define PERL_DTRACE_PROBE_PHASE(phase)
9049

9150
#endif
9251

‎perl.h

+1-1
Original file line numberDiff line numberDiff line change
@@ -5241,7 +5241,7 @@ EXTCONST char PL_bincompat_options[];
52415241

52425242
#ifndef PERL_SET_PHASE
52435243
# define PERL_SET_PHASE(new_phase) \
5244-
PHASE_CHANGE_PROBE(PL_phase_names[new_phase], PL_phase_names[PL_phase]); \
5244+
PERL_DTRACE_PROBE_PHASE(new_phase); \
52455245
PL_phase = new_phase;
52465246
#endif
52475247

‎pp_ctl.c

+2-2
Original file line numberDiff line numberDiff line change
@@ -3720,7 +3720,7 @@ PP(pp_require)
37203720
}
37213721
}
37223722

3723-
LOADING_FILE_PROBE(unixname);
3723+
PERL_DTRACE_PROBE_FILE_LOADING(unixname);
37243724

37253725
/* prepare to compile file */
37263726

@@ -4056,7 +4056,7 @@ PP(pp_require)
40564056
else
40574057
op = PL_op->op_next;
40584058

4059-
LOADED_FILE_PROBE(unixname);
4059+
PERL_DTRACE_PROBE_FILE_LOADED(unixname);
40604060

40614061
return op;
40624062
}

‎proto.h

+12
Original file line numberDiff line numberDiff line change
@@ -5494,6 +5494,18 @@ PERL_CALLCONV bool Perl_dump_c_backtrace(pTHX_ PerlIO* fp, int max_depth, int sk
54945494
PERL_CALLCONV Perl_c_backtrace* Perl_get_c_backtrace(pTHX_ int max_depth, int skip);
54955495
PERL_CALLCONV SV* Perl_get_c_backtrace_dump(pTHX_ int max_depth, int skip);
54965496
#endif
5497+
#if defined(USE_DTRACE)
5498+
PERL_CALLCONV void Perl_dtrace_probe_call(pTHX_ CV *cv, bool is_call);
5499+
#define PERL_ARGS_ASSERT_DTRACE_PROBE_CALL \
5500+
assert(cv)
5501+
PERL_CALLCONV void Perl_dtrace_probe_load(pTHX_ const char *name, bool is_loading);
5502+
#define PERL_ARGS_ASSERT_DTRACE_PROBE_LOAD \
5503+
assert(name)
5504+
PERL_CALLCONV void Perl_dtrace_probe_op(pTHX_ const OP *op);
5505+
#define PERL_ARGS_ASSERT_DTRACE_PROBE_OP \
5506+
assert(op)
5507+
PERL_CALLCONV void Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase);
5508+
#endif
54975509
#if defined(USE_ITHREADS)
54985510
PERL_CALLCONV PADOFFSET Perl_alloccopstash(pTHX_ HV *hv);
54995511
#define PERL_ARGS_ASSERT_ALLOCCOPSTASH \

‎run.c

+2-2
Original file line numberDiff line numberDiff line change
@@ -37,9 +37,9 @@ int
3737
Perl_runops_standard(pTHX)
3838
{
3939
OP *op = PL_op;
40-
OP_ENTRY_PROBE(OP_NAME(op));
40+
PERL_DTRACE_PROBE_OP(op);
4141
while ((PL_op = op = op->op_ppaddr(aTHX))) {
42-
OP_ENTRY_PROBE(OP_NAME(op));
42+
PERL_DTRACE_PROBE_OP(op);
4343
}
4444
PERL_ASYNC_CHECK();
4545

‎util.c

+78
Original file line numberDiff line numberDiff line change
@@ -6652,6 +6652,84 @@ int perl_tsa_mutex_destroy(perl_mutex* mutex)
66526652

66536653
#endif
66546654

6655+
6656+
#ifdef USE_DTRACE
6657+
6658+
/* log a sub call or return */
6659+
6660+
void
6661+
Perl_dtrace_probe_call(pTHX_ CV *cv, bool is_call)
6662+
{
6663+
const char *func;
6664+
const char *file;
6665+
const char *stash;
6666+
const COP *start;
6667+
line_t line;
6668+
6669+
PERL_ARGS_ASSERT_DTRACE_PROBE_CALL;
6670+
6671+
if (CvNAMED(cv)) {
6672+
HEK *hek = CvNAME_HEK(cv);
6673+
func = HEK_KEY(hek);
6674+
}
6675+
else {
6676+
GV *gv = CvGV(cv);
6677+
func = GvENAME(gv);
6678+
}
6679+
start = (const COP *)CvSTART(cv);
6680+
file = CopFILE(start);
6681+
line = CopLINE(start);
6682+
stash = CopSTASHPV(start);
6683+
6684+
if (is_call) {
6685+
PERL_SUB_ENTRY(func, file, line, stash);
6686+
}
6687+
else {
6688+
PERL_SUB_RETURN(func, file, line, stash);
6689+
}
6690+
}
6691+
6692+
6693+
/* log a require file loading/loaded */
6694+
6695+
void
6696+
Perl_dtrace_probe_load(pTHX_ const char *name, bool is_loading)
6697+
{
6698+
PERL_ARGS_ASSERT_DTRACE_PROBE_LOAD;
6699+
6700+
if (is_loading) {
6701+
PERL_LOADING_FILE(name);
6702+
}
6703+
else {
6704+
PERL_LOADED_FILE(name);
6705+
}
6706+
}
6707+
6708+
6709+
/* log an op execution */
6710+
6711+
void
6712+
Perl_dtrace_probe_op(pTHX_ const OP *op)
6713+
{
6714+
PERL_ARGS_ASSERT_DTRACE_PROBE_OP;
6715+
6716+
PERL_OP_ENTRY(OP_NAME(op));
6717+
}
6718+
6719+
6720+
/* log a compile/run phase change */
6721+
6722+
void
6723+
Perl_dtrace_probe_phase(pTHX_ enum perl_phase phase)
6724+
{
6725+
const char *ph_old = PL_phase_names[PL_phase];
6726+
const char *ph_new = PL_phase_names[phase];
6727+
6728+
PERL_PHASE_CHANGE(ph_new, ph_old);
6729+
}
6730+
6731+
#endif
6732+
66556733
/*
66566734
* ex: set ts=8 sts=4 sw=4 et:
66576735
*/

0 commit comments

Comments
 (0)
Please sign in to comment.