Change 14956 by ams@lustre on 2002/03/03 04:40:08
Subject: [PATCH @14577] Debugging OPs
From: Ilya Zakharevich <[EMAIL PROTECTED]>
Date: Sat, 2 Mar 2002 05:49:58 -0500
Message-Id: <[EMAIL PROTECTED]>
Affected files ...
.... //depot/perl/deb.c#26 edit
.... //depot/perl/dump.c#107 edit
.... //depot/perl/ext/Devel/Peek/Peek.pm#17 edit
.... //depot/perl/perl.c#408 edit
.... //depot/perl/perl.h#442 edit
.... //depot/perl/pod/perlrun.pod#54 edit
.... //depot/perl/sv.h#109 edit
Differences ...
==== //depot/perl/deb.c#26 (text) ====
Index: perl/deb.c
--- perl/deb.c.~1~ Sat Mar 2 21:45:05 2002
+++ perl/deb.c Sat Mar 2 21:45:05 2002
@@ -81,11 +81,14 @@
I32
Perl_debstack(pTHX)
{
-#ifdef DEBUGGING
+#ifndef SKIP_DEBUGGING
I32 top = PL_stack_sp - PL_stack_base;
register I32 i = top - 30;
I32 *markscan = PL_markstack + PL_curstackinfo->si_markoff;
+ if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+ return 0;
+
if (i < 0)
i = 0;
@@ -118,6 +121,6 @@
}
while (1);
PerlIO_printf(Perl_debug_log, "\n");
-#endif /* DEBUGGING */
+#endif /* SKIP_DEBUGGING */
return 0;
}
==== //depot/perl/dump.c#107 (text) ====
Index: perl/dump.c
--- perl/dump.c.~1~ Sat Mar 2 21:45:05 2002
+++ perl/dump.c Sat Mar 2 21:45:05 2002
@@ -1402,6 +1402,10 @@
CV *cv;
SV *sv;
STRLEN n_a;
+
+ if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+ return 0;
+
Perl_deb(aTHX_ "%s", OP_NAME(o));
switch (o->op_type) {
case OP_CONST:
@@ -1435,7 +1439,7 @@
PerlIO_printf(Perl_debug_log, "[%"UVuf"]", (UV)o->op_targ);
break;
default:
- break;
+ return 0;
}
PerlIO_printf(Perl_debug_log, "\n");
return 0;
@@ -1469,6 +1473,8 @@
STATIC void
S_debprof(pTHX_ OP *o)
{
+ if (CopSTASH_eq(PL_curcop, PL_debstash) && !DEBUG_J_TEST_)
+ return;
if (!PL_profiledata)
Newz(000, PL_profiledata, MAXO, U32);
++PL_profiledata[o->op_type];
==== //depot/perl/ext/Devel/Peek/Peek.pm#17 (text) ====
Index: perl/ext/Devel/Peek/Peek.pm
--- perl/ext/Devel/Peek/Peek.pm.~1~ Sat Mar 2 21:45:05 2002
+++ perl/ext/Devel/Peek/Peek.pm Sat Mar 2 21:45:05 2002
@@ -17,6 +17,26 @@
XSLoader::load 'Devel::Peek';
+sub import {
+ my $c = shift;
+ my $ops_rx = qr/^:opd(=[stP]*)?\b/;
+ my @db = grep m/$ops_rx/, @_;
+ @_ = grep !m/$ops_rx/, @_;
+ if (@db) {
+ die "Too many :opd options" if @db > 1;
+ runops_debug(1);
+ my $flags = ($db[0] =~ m/$ops_rx/ and $1);
+ $flags = 'st' unless defined $flags;
+ my $f = 0;
+ $f |= 2 if $flags =~ /s/;
+ $f |= 8 if $flags =~ /t/;
+ $f |= 64 if $flags =~ /P/;
+ $^D |= $f if $f;
+ }
+ unshift @_, $c;
+ goto &Exporter::import;
+}
+
sub DumpWithOP ($;$) {
local($Devel::Peek::dump_ops)=1;
my $depth = @_ > 1 ? $_[1] : 4 ;
@@ -58,6 +78,8 @@
DumpArray( 5, $a, $b, ... );
mstat "Point 5";
+ use Devel::Peek ':opd=st';
+
=head1 DESCRIPTION
Devel::Peek contains functions which allows raw Perl datatypes to be
@@ -88,6 +110,11 @@
number of character printed in various string values. Setting it to 0
means no limit.
+If C<use Devel::Peek> directive has a C<:opd=FLAGS> argument,
+this switches on debugging of opcode dispatch. C<FLAGS> should be a
+combination of C<s>, C<t>, and C<P> (see B<-D> flags in L<perlrun>).
+C<:opd> is a shortcut for C<:opd=st>.
+
=head2 Runtime debugging
C<CvGV($cv)> return one of the globs associated to a subroutine reference $cv.
==== //depot/perl/perl.c#408 (text) ====
Index: perl/perl.c
--- perl/perl.c.~1~ Sat Mar 2 21:45:05 2002
+++ perl/perl.c Sat Mar 2 21:45:05 2002
@@ -2257,7 +2257,7 @@
forbid_setid("-D");
if (isALPHA(s[1])) {
/* if adding extra options, remember to update DEBUG_MASK */
- static char debopts[] = "psltocPmfrxuLHXDSTR";
+ static char debopts[] = "psltocPmfrxuLHXDSTRJ";
char *d;
for (s++; *s && (d = strchr(debopts,*s)); s++)
==== //depot/perl/perl.h#442 (text) ====
Index: perl/perl.h
--- perl/perl.h.~1~ Sat Mar 2 21:45:05 2002
+++ perl/perl.h Sat Mar 2 21:45:05 2002
@@ -2358,11 +2358,12 @@
#define DEBUG_S_FLAG 0x00010000 /* 65536 */
#define DEBUG_T_FLAG 0x00020000 /* 131072 */
#define DEBUG_R_FLAG 0x00040000 /* 262144 */
-#define DEBUG_MASK 0x0007FFFF /* mask of all the standard flags */
+#define DEBUG_J_FLAG 0x00080000 /* 524288 */
+#define DEBUG_MASK 0x000FFFFF /* mask of all the standard flags */
#define DEBUG_DB_RECURSE_FLAG 0x40000000
-#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? */
-
+#define DEBUG_TOP_FLAG 0x80000000 /* XXX what's this for ??? Signal
+ that something was done? */
# define DEBUG_p_TEST_ (PL_debug & DEBUG_p_FLAG)
# define DEBUG_s_TEST_ (PL_debug & DEBUG_s_FLAG)
@@ -2383,6 +2384,7 @@
# define DEBUG_S_TEST_ (PL_debug & DEBUG_S_FLAG)
# define DEBUG_T_TEST_ (PL_debug & DEBUG_T_FLAG)
# define DEBUG_R_TEST_ (PL_debug & DEBUG_R_FLAG)
+# define DEBUG_J_TEST_ (PL_debug & DEBUG_J_FLAG)
#ifdef DEBUGGING
@@ -2408,6 +2410,7 @@
# define DEBUG_S_TEST DEBUG_S_TEST_
# define DEBUG_T_TEST DEBUG_T_TEST_
# define DEBUG_R_TEST DEBUG_R_TEST_
+# define DEBUG_J_TEST DEBUG_J_TEST_
# define DEB(a) a
# define DEBUG(a) if (PL_debug) a
@@ -2470,6 +2473,7 @@
# define DEBUG_S_TEST (0)
# define DEBUG_T_TEST (0)
# define DEBUG_R_TEST (0)
+# define DEBUG_J_TEST (0)
# define DEB(a)
# define DEBUG(a)
==== //depot/perl/pod/perlrun.pod#54 (text) ====
Index: perl/pod/perlrun.pod
--- perl/pod/perlrun.pod.~1~ Sat Mar 2 21:45:05 2002
+++ perl/pod/perlrun.pod Sat Mar 2 21:45:05 2002
@@ -313,7 +313,7 @@
8 t Trace execution
16 o Method and overloading resolution
32 c String/numeric conversions
- 64 P Print preprocessor command for -P, source file input state
+ 64 P Print profiling info, preprocessor command for -P, source file input
+state
128 m Memory allocation
256 f Format processing
512 r Regular expression parsing and execution
@@ -326,9 +326,11 @@
65536 S Thread synchronization
131072 T Tokenising
262144 R Include reference counts of dumped variables (eg when using -Ds)
+ 524288 J Do not s,t,P-debug (Jump over) opcodes within package DB
All these flags require B<-DDEBUGGING> when you compile the Perl
-executable. See the F<INSTALL> file in the Perl source distribution
+executable (but see L<Devel::Peek>, L<re> which may change this).
+See the F<INSTALL> file in the Perl source distribution
for how to do this. This flag is automatically set if you include B<-g>
option when C<Configure> asks you about optimizer/debugger flags.
==== //depot/perl/sv.h#109 (text) ====
Index: perl/sv.h
--- perl/sv.h.~1~ Sat Mar 2 21:45:05 2002
+++ perl/sv.h Sat Mar 2 21:45:05 2002
@@ -1229,7 +1229,7 @@
#define SvSetMagicSV_nosteal(dst,src) \
SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst))
-#ifdef DEBUGGING
+#if !defined(SKIP_DEBUGGING)
#define SvPEEK(sv) sv_peek(sv)
#else
#define SvPEEK(sv) ""
End of Patch.
