From 3f6bd23a1b9204dda7aaaef6efe17dc87f50a675 Mon Sep 17 00:00:00 2001 From: David Mitchell Date: Mon, 15 Feb 2016 13:48:24 +0000 Subject: [PATCH] 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. --- dump.c | 2 +- embed.fnc | 7 +++++ inline.h | 14 ++------- makedef.pl | 9 ++++++ mydtrace.h | 89 +++++++++++++++--------------------------------------- perl.h | 2 +- pp_ctl.c | 4 +-- proto.h | 12 ++++++++ run.c | 4 +-- util.c | 78 +++++++++++++++++++++++++++++++++++++++++++++++ 10 files changed, 138 insertions(+), 83 deletions(-) diff --git a/dump.c b/dump.c index dcc00f5891..c1303b6b9f 100644 --- a/dump.c +++ b/dump.c @@ -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(); diff --git a/embed.fnc b/embed.fnc index 049f6c180f..d114b2bb63 100644 --- a/embed.fnc +++ b/embed.fnc @@ -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: diff --git a/inline.h b/inline.h index 9a674bce85..f44887064c 100644 --- a/inline.h +++ b/inline.h @@ -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); diff --git a/makedef.pl b/makedef.pl index fd3bf62ffe..78ee0b17f5 100644 --- a/makedef.pl +++ b/makedef.pl @@ -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 diff --git a/mydtrace.h b/mydtrace.h index 6e797676fa..6c66a08509 100644 --- a/mydtrace.h +++ b/mydtrace.h @@ -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 diff --git a/perl.h b/perl.h index b387257739..2ee79c4262 100644 --- a/perl.h +++ b/perl.h @@ -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 diff --git a/pp_ctl.c b/pp_ctl.c index 9bab70ad54..7b31bbb324 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -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; } diff --git a/proto.h b/proto.h index 88078676d6..044d31e373 100644 --- a/proto.h +++ b/proto.h @@ -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 \ diff --git a/run.c b/run.c index 1a62e9d66f..352bfbc18c 100644 --- a/run.c +++ b/run.c @@ -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(); diff --git a/util.c b/util.c index 98e6be545a..fa27ecb0da 100644 --- a/util.c +++ b/util.c @@ -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: */