This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
-DPERL_TRACE_OPS to produce reports on executed OP counts
authorSteffen Mueller <smueller@cpan.org>
Tue, 2 Jul 2013 17:06:01 +0000 (19:06 +0200)
committerSteffen Mueller <smueller@cpan.org>
Tue, 2 Jul 2013 17:19:07 +0000 (19:19 +0200)
This produces a report on the number of OPs of a given type that were
executed at the end of a program run. This can be useful in multiple
ways. One, it can help determine hotspots for optimization (yes, I know
execution count is not equal execution time). It can also help with
determining whether a given change to perl has had the desired effect on
deterministic programs.

dump.c
embedvar.h
intrpvar.h
perl.c

diff --git a/dump.c b/dump.c
index e7900c3..5ca838b 100644 (file)
--- 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,
index 0c34c0f..ef2fa68 100644 (file)
 #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)
index 6a0fd10..f6827f2 100644 (file)
@@ -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 5ba7c9a..feb031b 100644 (file)
--- 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;