Add a flag PERLDBf_SAVESRC, which enables the saved lines part of

PERLDBf_LINE, so that profilers (such as NYTProf) have access to the
lines of the eval, without the speed impact of other parts of the
debugger infrastructure. PERLDBf_LINE is unchanged. Based largely on a
patch by Tim Bunce in <20081028152749.GA12500@timac.local>

p4raw-id: //depot/perl@34693

diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index d5d3c08..41e7c52 100644 (file)
--- a/lib/perl5db.pl
+++ b/lib/perl5db.pl
@@ -8703,8 +8703,12 @@ BEGIN {
         PERLDBf_GOTO      => 0x80,     # Report goto: call DB::goto
         PERLDBf_NAMEEVAL  => 0x100,    # Informative names for evals
         PERLDBf_NAMEANON  => 0x200,    # Informative names for anon subs
+        PERLDBf_SAVESRC   => 0x400,    # Save source lines into @{"_<$filename"}
         PERLDB_ALL        => 0x33f,    # No _NONAME, _GOTO
     );
+    # PERLDBf_LINE also enables the actions of PERLDBf_SAVESRC, so the debugger
+    # doesn't need to set it. It's provided for the benefit of profilers and
+    # other code analysers.
 
     %DollarCaretP_flags_r = reverse %DollarCaretP_flags;
 }

diff --git a/perl.h b/perl.h
index a3272bc..e07416e 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -5323,7 +5323,8 @@ typedef struct am_table_short AMTS;
 #define PERLDB_ALL             (PERLDBf_SUB    | PERLDBf_LINE  |       \
                                 PERLDBf_NOOPT  | PERLDBf_INTER |       \
                                 PERLDBf_SUBLINE| PERLDBf_SINGLE|       \
-                                PERLDBf_NAMEEVAL| PERLDBf_NAMEANON )
+                                PERLDBf_NAMEEVAL| PERLDBf_NAMEANON |   \
+                                PERLDBf_SAVESRC)
                                        /* No _NONAME, _GOTO, _ASSERTION */
 #define PERLDBf_SUB            0x01    /* Debug sub enter/exit */
 #define PERLDBf_LINE           0x02    /* Keep line # */
@@ -5336,6 +5337,7 @@ typedef struct am_table_short AMTS;
 #define PERLDBf_GOTO           0x80    /* Report goto: call DB::goto */
 #define PERLDBf_NAMEEVAL       0x100   /* Informative names for evals */
 #define PERLDBf_NAMEANON       0x200   /* Informative names for anon subs */
+#define PERLDBf_SAVESRC        0x400   /* Save source lines into @{"_<$filename"} */
 
 #define PERLDB_SUB     (PL_perldb && (PL_perldb & PERLDBf_SUB))
 #define PERLDB_LINE    (PL_perldb && (PL_perldb & PERLDBf_LINE))
@@ -5348,6 +5350,7 @@ typedef struct am_table_short AMTS;
 #define PERLDB_NAMEEVAL        (PL_perldb && (PL_perldb & PERLDBf_NAMEEVAL))
 #define PERLDB_NAMEANON        (PL_perldb && (PL_perldb & PERLDBf_NAMEANON))
 #define PERLDB_ASSERTION (PL_perldb && (PL_perldb & PERLDBf_ASSERTION))
+#define PERLDB_SAVESRC         (PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
 
 #ifdef USE_LOCALE_NUMERIC
 

diff --git a/pp_ctl.c b/pp_ctl.c
index 8351d53..2067495 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3725,11 +3725,12 @@ PP(pp_entereval)
 
     /* prepare to compile string */
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash)
+    if (PERLDB_SAVESRC && PL_curstash != PL_debstash)
        save_lines(CopFILEAV(&PL_compiling), PL_parser->linestr);
     PUTBACK;
     ok = doeval(gimme, NULL, runcv, seq);
-    if (PERLDB_INTER && was != (I32)PL_sub_generation /* Some subs defined here. */
+    if ((PERLDB_LINE || PERLDB_SAVESRC)
+       && was != (I32)PL_sub_generation /* Some subs defined here. */
        && ok) {
        /* Copy in anything fake and short. */
        my_strlcpy(safestr, fakestr, fakelen);