From: Ilya Zakharevich Date: Sat, 2 Mar 2002 05:49:58 +0000 (-0500) Subject: Debugging OPs X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=1045810a2eefbb8aa6c05bba7cac36942959fec7;p=p5sagit%2Fp5-mst-13.2.git Debugging OPs Message-Id: <20020302054958.A5511@math.ohio-state.edu> p4raw-link: @14577 on //depot/perl: 0ad5258ff3f3328f321188cbb4fcd6a74b365431 p4raw-id: //depot/perl@14956 --- diff --git a/deb.c b/deb.c index fae944c..6a5a21c 100644 --- a/deb.c +++ b/deb.c @@ -81,11 +81,14 @@ Perl_debstackptrs(pTHX) 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 @@ Perl_debstack(pTHX) } while (1); PerlIO_printf(Perl_debug_log, "\n"); -#endif /* DEBUGGING */ +#endif /* SKIP_DEBUGGING */ return 0; } diff --git a/dump.c b/dump.c index 0a36024..9b2ff67 100644 --- a/dump.c +++ b/dump.c @@ -1402,6 +1402,10 @@ Perl_debop(pTHX_ OP *o) 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 @@ Perl_debop(pTHX_ OP *o) 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 @@ Perl_watch(pTHX_ char **addr) 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]; diff --git a/ext/Devel/Peek/Peek.pm b/ext/Devel/Peek/Peek.pm index ecc44b7..3b4b845 100644 --- a/ext/Devel/Peek/Peek.pm +++ b/ext/Devel/Peek/Peek.pm @@ -17,6 +17,26 @@ use XSLoader (); 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 @@ Devel::Peek - A data debugging tool for the XS programmer 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 @@ The global variable $Devel::Peek::pv_limit can be set to limit the number of character printed in various string values. Setting it to 0 means no limit. +If C directive has a C<:opd=FLAGS> argument, +this switches on debugging of opcode dispatch. C should be a +combination of C, C, and C

(see B<-D> flags in L). +C<:opd> is a shortcut for C<:opd=st>. + =head2 Runtime debugging C return one of the globs associated to a subroutine reference $cv. diff --git a/perl.c b/perl.c index 91a3dda..a2921fb 100644 --- a/perl.c +++ b/perl.c @@ -2257,7 +2257,7 @@ Perl_moreswitches(pTHX_ char *s) 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++) diff --git a/perl.h b/perl.h index 2fffc93..61d17fd 100644 --- a/perl.h +++ b/perl.h @@ -2358,11 +2358,12 @@ Gid_t getegid (void); #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 @@ Gid_t getegid (void); # 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 @@ Gid_t getegid (void); # 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 @@ Gid_t getegid (void); # 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) diff --git a/pod/perlrun.pod b/pod/perlrun.pod index 0a709bd..9bbb8d9 100644 --- a/pod/perlrun.pod +++ b/pod/perlrun.pod @@ -313,7 +313,7 @@ B<-D14> is equivalent to B<-Dtls>): 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 @@ B<-D14> is equivalent to B<-Dtls>): 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 file in the Perl source distribution +executable (but see L, L which may change this). +See the F file in the Perl source distribution for how to do this. This flag is automatically set if you include B<-g> option when C asks you about optimizer/debugger flags. diff --git a/sv.h b/sv.h index d925421..8fd4ae7 100644 --- a/sv.h +++ b/sv.h @@ -1229,7 +1229,7 @@ Returns a pointer to the character buffer. #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) ""