Change 34726 by [EMAIL PROTECTED] on 2008/11/04 21:39:52
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 <[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.8/perl/gv.c#120 integrate
... //depot/maint-5.8/perl/lib/perl5db.pl#35 integrate
... //depot/maint-5.8/perl/op.c#236 integrate
... //depot/maint-5.8/perl/perl.h#188 integrate
... //depot/maint-5.8/perl/pod/perlvar.pod#50 integrate
... //depot/maint-5.8/perl/pp_ctl.c#197 integrate
... //depot/maint-5.8/perl/toke.c#184 integrate
Differences ...
==== //depot/maint-5.8/perl/gv.c#120 (text) ====
Index: perl/gv.c
--- perl/gv.c#119~34633~ 2008-10-29 01:22:26.000000000 -0700
+++ perl/gv.c 2008-11-04 13:39:52.000000000 -0800
@@ -137,7 +137,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.8/perl/lib/perl5db.pl#35 (text) ====
Index: perl/lib/perl5db.pl
--- perl/lib/perl5db.pl#34~34345~ 2008-09-11 08:13:21.000000000 -0700
+++ perl/lib/perl5db.pl 2008-11-04 13:39:52.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.8/perl/op.c#236 (text) ====
Index: perl/op.c
--- perl/op.c#235~34718~ 2008-11-04 01:38:17.000000000 -0800
+++ perl/op.c 2008-11-04 13:39:52.000000000 -0800
@@ -3703,7 +3703,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.8/perl/perl.h#188 (text) ====
Index: perl/perl.h
--- perl/perl.h#187~34633~ 2008-10-29 01:22:26.000000000 -0700
+++ perl/perl.h 2008-11-04 13:39:52.000000000 -0800
@@ -5108,7 +5108,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 */
#define PERLDBf_SUB 0x01 /* Debug sub enter/exit */
#define PERLDBf_LINE 0x02 /* Keep line # */
@@ -5121,6 +5122,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))
@@ -5133,6 +5135,7 @@
#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
==== //depot/maint-5.8/perl/pod/perlvar.pod#50 (text) ====
Index: perl/pod/perlvar.pod
--- perl/pod/perlvar.pod#49~33204~ 2008-02-02 10:16:39.000000000 -0800
+++ perl/pod/perlvar.pod 2008-11-04 13:39:52.000000000 -0800
@@ -1146,7 +1146,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
@@ -1183,12 +1184,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.8/perl/pp_ctl.c#197 (text) ====
Index: perl/pp_ctl.c
--- perl/pp_ctl.c#196~34718~ 2008-11-04 01:38:17.000000000 -0800
+++ perl/pp_ctl.c 2008-11-04 13:39:52.000000000 -0800
@@ -3537,7 +3537,7 @@
/* 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 @@
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);
==== //depot/maint-5.8/perl/toke.c#184 (text) ====
Index: perl/toke.c
--- perl/toke.c#183~34718~ 2008-11-04 01:38:17.000000000 -0800
+++ perl/toke.c 2008-11-04 13:39:52.000000000 -0800
@@ -885,7 +885,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);
}
}
@@ -2891,7 +2891,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;
}
@@ -2973,7 +2973,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;
@@ -3141,7 +3141,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 */
@@ -3151,7 +3151,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;
}
@@ -9879,7 +9879,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);
@@ -10341,7 +10341,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.
