From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 1 Nov 2008 14:51:05 +0000 (+0000)
Subject: Add a flag PERLDBf_SAVESRC, which enables the saved lines part of
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b8fcbefe6253f6cbcf6817158c0e99c8018b2d46;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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);