Change 34715 by [EMAIL PROTECTED] on 2008/11/04 08:28:29
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 <[EMAIL PROTECTED]>
[ 34705]
Subject: Re: @{"_<$filename"} is unreasonably tied to use of DB::DB
($^P & 0x2)
From: Tim Bunce <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
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 <[EMAIL PROTECTED]>
Message-ID: <[EMAIL PROTECTED]>
Date: Mon, 3 Nov 2008 16:25:37 +0000
Affected files ...
... //depot/maint-5.10/perl/gv.c#6 integrate
... //depot/maint-5.10/perl/lib/perl5db.pl#4 integrate
... //depot/maint-5.10/perl/op.c#18 integrate
... //depot/maint-5.10/perl/perl.h#16 integrate
... //depot/maint-5.10/perl/pod/perlvar.pod#3 integrate
... //depot/maint-5.10/perl/pp_ctl.c#24 integrate
... //depot/maint-5.10/perl/toke.c#11 integrate
Differences ...
==== //depot/maint-5.10/perl/gv.c#6 (text) ====
Index: perl/gv.c
--- perl/gv.c#5~34599~ 2008-10-26 14:44:48.000000000 -0700
+++ perl/gv.c 2008-11-04 00:28:29.000000000 -0800
@@ -139,7 +139,7 @@
#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)
==== //depot/maint-5.10/perl/lib/perl5db.pl#4 (text) ====
Index: perl/lib/perl5db.pl
--- perl/lib/perl5db.pl#3~34340~ 2008-09-11 02:37:00.000000000 -0700
+++ perl/lib/perl5db.pl 2008-11-04 00:28:29.000000000 -0800
@@ -8703,8 +8703,12 @@
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;
}
==== //depot/maint-5.10/perl/op.c#18 (text) ====
Index: perl/op.c
--- perl/op.c#17~34707~ 2008-11-03 11:50:31.000000000 -0800
+++ perl/op.c 2008-11-04 00:28:29.000000000 -0800
@@ -4285,7 +4285,8 @@
#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);
==== //depot/maint-5.10/perl/perl.h#16 (text) ====
Index: perl/perl.h
--- perl/perl.h#15~34599~ 2008-10-26 14:44:48.000000000 -0700
+++ perl/perl.h 2008-11-04 00:28:29.000000000 -0800
@@ -5297,7 +5297,8 @@
#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 # */
@@ -5310,6 +5311,7 @@
#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))
@@ -5322,6 +5324,7 @@
#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
==== //depot/maint-5.10/perl/pod/perlvar.pod#3 (text) ====
Index: perl/pod/perlvar.pod
--- perl/pod/perlvar.pod#2~33123~ 2008-01-30 03:45:08.000000000 -0800
+++ perl/pod/perlvar.pod 2008-11-04 00:28:29.000000000 -0800
@@ -1217,7 +1217,8 @@
=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
@@ -1254,12 +1255,13 @@
=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
==== //depot/maint-5.10/perl/pp_ctl.c#24 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#23~34707~ 2008-11-03 11:50:31.000000000 -0800
+++ perl/pp_ctl.c 2008-11-04 00:28:29.000000000 -0800
@@ -3648,11 +3648,12 @@
/* 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);
==== //depot/maint-5.10/perl/toke.c#11 (text) ====
Index: perl/toke.c
--- perl/toke.c#10~34707~ 2008-11-03 11:50:31.000000000 -0800
+++ perl/toke.c 2008-11-04 00:28:29.000000000 -0800
@@ -1149,7 +1149,7 @@
/* 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);
}
@@ -3657,7 +3657,7 @@
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;
}
@@ -3750,7 +3750,7 @@
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;
@@ -3923,7 +3923,7 @@
} 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 */
@@ -3933,7 +3933,7 @@
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;
}
@@ -11313,7 +11313,7 @@
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);
@@ -11809,7 +11809,7 @@
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 */
End of Patch.
