Integrate:

[ 34715]
Integrate:
[ 34693]
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>

[ 34705]
Subject: Re: @{"_<$filename"} is unreasonably tied to use of DB::DB ($^P & 0x2)
Message-ID: <20081103160130.GA45762@timac.local>
Date: Mon, 3 Nov 2008 16:01:31 +0000

[ 34706]
Subject: Re: @{"_<$filename"} is unreasonably tied to use of DB::DB ($^P & 0x2)
From: Tim Bunce <Tim.Bunce@pobox.com>
Message-ID: <20081103162537.GB45762@timac.local>
Date: Mon, 3 Nov 2008 16:25:37 +0000
p4raw-link: @34715 on //depot/maint-5.10/perl: 2d2a15363346b8095658197c866218a0ef8f09f2
p4raw-link: @34706 on //depot/perl: 4c85b59c156c7ad7ba08eb430618e674134ced22
p4raw-link: @34705 on //depot/perl: 65269a95bf2e18461f4efd8a5e0ad5bb7d043a5e
p4raw-link: @34693 on //depot/perl: b8fcbefe6253f6cbcf6817158c0e99c8018b2d46

p4raw-id: //depot/maint-5.8/perl@34726
p4raw-integrated: from //depot/maint-5.10/perl@34725 'edit in' perl.h
	(@34599..) 'merge in' pod/perlvar.pod (@33123..) lib/perl5db.pl
	(@34340..) gv.c (@34599..) op.c pp_ctl.c toke.c (@34707..)

7 files changed, 25 insertions, 14 deletions

diff --git a/gv.c b/gv.c
index 360eee9934..e809c12221 100644
--- a/gv.c
+++ b/gv.c
@@ -137,7 +137,7 @@ Perl_gv_fetchfile_flags(pTHX_ const char *const name, const STRLEN namelen,
 #else
 	sv_setpvn(GvSV(gv), name, namelen);
 #endif
-	if (PERLDB_LINE)
+	if (PERLDB_LINE || PERLDB_SAVESRC)
 	    hv_magic(GvHVn(gv_AVadd(gv)), NULL, PERL_MAGIC_dbfile);
     }
     if (tmpbuf != smallbuf)
diff --git a/lib/perl5db.pl b/lib/perl5db.pl
index e0e03e63e6..e5162f8400 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/op.c b/op.c
index 1251b9c147..aeb8f4ad2e 100644
--- a/op.c
+++ b/op.c
@@ -3703,7 +3703,8 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 #endif
     CopSTASH_set(cop, PL_curstash);
 
-    if (PERLDB_LINE && PL_curstash != PL_debstash) {
+    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash) {
+	/* this line can have a breakpoint - store the cop in IV */
 	AV *av = CopFILEAVx(PL_curcop);
 	if (av) {
 	    SV * const * const svp = av_fetch(av, (I32)CopLINE(cop), FALSE);
diff --git a/perl.h b/perl.h
index bbb18ff935..d4d8626c24 100644
--- a/perl.h
+++ b/perl.h
@@ -5108,7 +5108,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 */
 #define PERLDBf_SUB		0x01	/* Debug sub enter/exit */
 #define PERLDBf_LINE		0x02	/* Keep line # */
@@ -5121,6 +5122,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))
@@ -5133,6 +5135,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_SAVESRC 	(PL_perldb && (PL_perldb & PERLDBf_SAVESRC))
 
 #ifdef USE_LOCALE_NUMERIC
 
diff --git a/pod/perlvar.pod b/pod/perlvar.pod
index 772822dbe7..7230255fe1 100644
--- a/pod/perlvar.pod
+++ b/pod/perlvar.pod
@@ -1146,7 +1146,8 @@ Debug subroutine enter/exit.
 
 =item 0x02
 
-Line-by-line debugging.
+Line-by-line debugging. Causes DB::DB() subroutine to be called for each
+statement executed. Also causes saving source code lines (like 0x400).
 
 =item 0x04
 
@@ -1183,12 +1184,13 @@ were compiled.
 
 =item 0x400
 
-Debug assertion subroutines enter/exit.
+Save source code lines into C<@{"_<$filename"}>.
 
 =back
 
 Some bits may be relevant at compile-time only, some at
 run-time only.  This is a new mechanism and the details may change.
+See also L<perldebguts>.
 
 =item $LAST_REGEXP_CODE_RESULT
 
diff --git a/pp_ctl.c b/pp_ctl.c
index edde8d085c..d7d1b0bad8 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -3537,7 +3537,7 @@ 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_linestr);
     PUTBACK;
 #ifdef USE_5005THREADS
@@ -3549,7 +3549,8 @@ PP(pp_entereval)
     MUTEX_UNLOCK(&PL_eval_mutex);
 #endif /* USE_5005THREADS */
     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);
diff --git a/toke.c b/toke.c
index 82790bde31..6b1b8e4a6f 100644
--- a/toke.c
+++ b/toke.c
@@ -885,7 +885,7 @@ S_skipspace(pTHX_ register char *s)
 	/* debugger active and we're not compiling the debugger code,
 	 * so store the line into the debugger's array of lines
 	 */
-	if (PERLDB_LINE && PL_curstash != PL_debstash)
+	if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 	    update_debugger_info(NULL, PL_bufptr, PL_bufend - PL_bufptr);
     }
 }
@@ -2891,7 +2891,7 @@ Perl_yylex(pTHX)
 	    PL_oldoldbufptr = PL_oldbufptr = s = PL_linestart = SvPVX(PL_linestr);
 	    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
 	    PL_last_lop = PL_last_uni = NULL;
-	    if (PERLDB_LINE && PL_curstash != PL_debstash)
+	    if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 		update_debugger_info(PL_linestr, NULL, 0);
 	    goto retry;
 	}
@@ -2973,7 +2973,7 @@ Perl_yylex(pTHX)
 	    incline(s);
 	} while (PL_doextract);
 	PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = s;
-	if (PERLDB_LINE && PL_curstash != PL_debstash)
+	if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 	    update_debugger_info(PL_linestr, NULL, 0);
 	PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
 	PL_last_lop = PL_last_uni = NULL;
@@ -3141,7 +3141,7 @@ Perl_yylex(pTHX)
 			    } while (argc && argv[0][0] == '-' && argv[0][1]);
 			    init_argv_symbols(argc,argv);
 			}
-			if ((PERLDB_LINE && !oldpdb) ||
+			if (((PERLDB_LINE || PERLDB_SAVESRC) && !oldpdb) ||
 			    ((PL_minus_n || PL_minus_p) && !(oldn || oldp)))
 			      /* if we have already added "LINE: while (<>) {",
 			         we must not do it again */
@@ -3151,7 +3151,7 @@ Perl_yylex(pTHX)
 			    PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
 			    PL_last_lop = PL_last_uni = NULL;
 			    PL_preambled = FALSE;
-			    if (PERLDB_LINE)
+			    if (PERLDB_LINE || PERLDB_SAVESRC)
 				(void)gv_fetchfile(PL_origfilename);
 			    goto retry;
 			}
@@ -9879,7 +9879,7 @@ S_scan_heredoc(pTHX_ register char *s)
 	else if (PL_bufend - PL_linestart == 1 && PL_bufend[-1] == '\r')
 	    PL_bufend[-1] = '\n';
 #endif
-	if (PERLDB_LINE && PL_curstash != PL_debstash)
+	if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 	    update_debugger_info(PL_linestr, NULL, 0);
 	if (*s == term && memEQ(s,PL_tokenbuf,len)) {
 	    STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
@@ -10341,7 +10341,7 @@ S_scan_str(pTHX_ char *start, int keep_quoted, int keep_delims)
 	CopLINE_inc(PL_curcop);
 
 	/* update debugger info */
-	if (PERLDB_LINE && PL_curstash != PL_debstash)
+	if ((PERLDB_LINE || PERLDB_SAVESRC) && PL_curstash != PL_debstash)
 	    update_debugger_info(PL_linestr, NULL, 0);
 
 	/* having changed the buffer, we must update PL_bufend */