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();
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:
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;
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);
);
}
+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
# 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 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 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 LOADING_FILE_PROBE(name) \
- if (PERL_LOADING_FILE_ENABLED()) { \
- const char *tmp_name = name; \
- PERL_LOADING_FILE(tmp_name); \
- }
-
-# 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 PERL_DTRACE_PROBE_RETURN(cv) \
+ if (PERL_SUB_ENTRY_ENABLED()) \
+ Perl_dtrace_probe_call(aTHX_ cv, FALSE);
-# define LOADED_FILE_PROBE(name) \
- if (PERL_LOADED_FILE_ENABLED()) { \
- PERL_LOADED_FILE(name); \
- }
+# define PERL_DTRACE_PROBE_FILE_LOADING(name) \
+ if (PERL_SUB_ENTRY_ENABLED()) \
+ Perl_dtrace_probe_load(aTHX_ name, TRUE);
-# endif
+# define PERL_DTRACE_PROBE_FILE_LOADED(name) \
+ if (PERL_SUB_ENTRY_ENABLED()) \
+ Perl_dtrace_probe_load(aTHX_ name, FALSE);
-# define OP_ENTRY_PROBE(name) \
- if (PERL_OP_ENTRY_ENABLED()) { \
- PERL_OP_ENTRY(name); \
- }
+# define PERL_DTRACE_PROBE_OP(op) \
+ if (PERL_OP_ENTRY_ENABLED()) \
+ Perl_dtrace_probe_op(aTHX_ op);
-# 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
#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
}
}
- LOADING_FILE_PROBE(unixname);
+ PERL_DTRACE_PROBE_FILE_LOADING(unixname);
/* prepare to compile file */
else
op = PL_op->op_next;
- LOADED_FILE_PROBE(unixname);
+ PERL_DTRACE_PROBE_FILE_LOADED(unixname);
return op;
}
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 \
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();
#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:
*/