summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--dump.c3
-rw-r--r--embedvar.h1
-rw-r--r--intrpvar.h9
-rw-r--r--perl.c18
4 files changed, 31 insertions, 0 deletions
diff --git a/dump.c b/dump.c
index e7900c35bb..5ca838b043 100644
--- a/dump.c
+++ b/dump.c
@@ -2213,6 +2213,9 @@ Perl_runops_debug(pTHX)
DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n"));
do {
+#ifdef PERL_TRACE_OPS
+ ++PL_op_exec_cnt[PL_op->op_type];
+#endif
if (PL_debug) {
if (PL_watchaddr && (*PL_watchaddr != PL_watchok))
PerlIO_printf(Perl_debug_log,
diff --git a/embedvar.h b/embedvar.h
index 0c34c0f3c6..ef2fa686a8 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -216,6 +216,7 @@
#define PL_ofsgv (vTHX->Iofsgv)
#define PL_oldname (vTHX->Ioldname)
#define PL_op (vTHX->Iop)
+#define PL_op_exec_cnt (vTHX->Iop_exec_cnt)
#define PL_op_mask (vTHX->Iop_mask)
#define PL_opfreehook (vTHX->Iopfreehook)
#define PL_opsave (vTHX->Iopsave)
diff --git a/intrpvar.h b/intrpvar.h
index 6a0fd10f33..f6827f2bd5 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -777,6 +777,15 @@ PERLVARI(I, sv_serial, U32, 0) /* SV serial number, used in sv.c */
PERLVARA(I, sv_consts, SV_CONSTS_COUNT, SV*) /* constant SVs with precomputed hash value */
+#ifdef PERL_TRACE_OPS
+PERLVARA(I, op_exec_cnt, OP_max+2, UV) /* Counts of executed OPs of the given type.
+ If PERL_TRACE_OPS is enabled, we'll dump
+ a summary count of all ops executed in the
+ program at perl_destruct time. For
+ profiling/debugging only. Works only if
+ DEBUGGING is enabled, too. */
+#endif
+
/* If you are adding a U8 or U16, check to see if there are 'Space' comments
* above on where there are gaps which currently will be structure padding. */
diff --git a/perl.c b/perl.c
index 5ba7c9a9b4..feb031b7d3 100644
--- a/perl.c
+++ b/perl.c
@@ -238,6 +238,10 @@ perl_construct(pTHXx)
#endif
PL_curcop = &PL_compiling; /* needed by ckWARN, right away */
+#ifdef PERL_TRACE_OPS
+ Zero(PL_op_exec_cnt, OP_max+2, UV);
+#endif
+
init_constants();
SvREADONLY_on(&PL_sv_placeholder);
@@ -568,6 +572,20 @@ perl_destruct(pTHXx)
/* Need to flush since END blocks can produce output */
my_fflush_all();
+#ifdef PERL_TRACE_OPS
+ /* If we traced all Perl OP usage, report and clean up */
+ PerlIO_printf(Perl_debug_log, "Trace of all OPs executed:\n");
+ for (i = 0; i <= OP_max; ++i) {
+ PerlIO_printf(Perl_debug_log, " %s: %"UVuf"\n", PL_op_name[i], PL_op_exec_cnt[i]);
+ PL_op_exec_cnt[i] = 0;
+ }
+ /* Utility slot for easily doing little tracing experiments in the runloop: */
+ if (PL_op_exec_cnt[OP_max+1] != 0)
+ PerlIO_printf(Perl_debug_log, " SPECIAL: %"UVuf"\n", PL_op_exec_cnt[OP_max+1]);
+ PerlIO_printf(Perl_debug_log, "\n");
+#endif
+
+
if (PL_threadhook(aTHX)) {
/* Threads hook has vetoed further cleanup */
PL_veto_cleanup = TRUE;