diff options
| -rw-r--r-- | cop.h | 44 | ||||
| -rw-r--r-- | embedvar.h | 6 | ||||
| -rw-r--r-- | mg.c | 17 | ||||
| -rw-r--r-- | op.c | 22 | ||||
| -rw-r--r-- | perlapi.h | 6 | ||||
| -rw-r--r-- | perlvars.h | 4 | ||||
| -rw-r--r-- | pp_ctl.c | 4 | ||||
| -rw-r--r-- | t/run/switchd.t | 19 |
8 files changed, 91 insertions, 31 deletions
@@ -370,27 +370,41 @@ string/length pair. #include "mydtrace.h" -struct cop { - BASEOP - /* On LP64 putting this here takes advantage of the fact that BASEOP isn't - an exact multiple of 8 bytes to save structure padding. */ - line_t cop_line; /* line # of this command */ - /* label for this construct is now stored in cop_hints_hash */ #ifdef USE_ITHREADS - PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the - package the line was compiled in */ +# define _COP_STASH_N_FILE \ + PADOFFSET cop_stashoff; /* offset into PL_stashpad, for the \ + package the line was compiled in */ \ char * cop_file; /* file name the following line # is from */ #else - HV * cop_stash; /* package line was compiled in */ +# define _COP_STASH_N_FILE \ + HV * cop_stash; /* package line was compiled in */ \ GV * cop_filegv; /* file the following line # is from */ #endif - U32 cop_hints; /* hints bits from pragmata */ - U32 cop_seq; /* parse sequence number */ - /* Beware. mg.c and warnings.pl assume the type of this is STRLEN *: */ - STRLEN * cop_warnings; /* lexical warnings bitmask */ - /* compile time state of %^H. See the comment in op.c for how this is - used to recreate a hash to return from caller. */ + +#define _COP_FIELDS \ + /* On LP64 putting this here takes advantage of the fact that BASEOP \ + isn't an exact multiple of 8 bytes to save structure padding. */ \ + line_t cop_line; /* line # of this command */ \ + /* label for this construct is now stored in cop_hints_hash */ \ + _COP_STASH_N_FILE \ + U32 cop_hints; /* hints bits from pragmata */ \ + U32 cop_seq; /* parse sequence number */ \ + /* Beware. mg.c and warnings.pl assume the type of this \ + is STRLEN *: */ \ + STRLEN * cop_warnings; /* lexical warnings bitmask */ \ + /* compile time state of %^H. See the comment in op.c for how this \ + is used to recreate a hash to return from caller. */ \ COPHH * cop_hints_hash; + +struct cop { + BASEOP + _COP_FIELDS +}; + +struct dbop { + BASEOP + _COP_FIELDS + size_t dbop_seq; /* sequence number for breakpoint */ }; #ifdef USE_ITHREADS diff --git a/embedvar.h b/embedvar.h index 06d4e181a0..f90a19e8a6 100644 --- a/embedvar.h +++ b/embedvar.h @@ -357,6 +357,12 @@ #define PL_appctx (my_vars->Gappctx) #define PL_Gappctx (my_vars->Gappctx) +#define PL_breakpoints (my_vars->Gbreakpoints) +#define PL_Gbreakpoints (my_vars->Gbreakpoints) +#define PL_breakpointseq (my_vars->Gbreakpointseq) +#define PL_Gbreakpointseq (my_vars->Gbreakpointseq) +#define PL_breakpointslen (my_vars->Gbreakpointslen) +#define PL_Gbreakpointslen (my_vars->Gbreakpointslen) #define PL_check (my_vars->Gcheck) #define PL_Gcheck (my_vars->Gcheck) #define PL_check_mutex (my_vars->Gcheck_mutex) @@ -2002,19 +2002,14 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) sv_2iv(MUTABLE_SV((mg)->mg_ptr)), FALSE); if (svp && SvIOKp(*svp)) { - OP * const o = INT2PTR(OP*,SvIVX(*svp)); - if (o) { -#ifdef PERL_DEBUG_READONLY_OPS - Slab_to_rw(OpSLAB(o)); -#endif - /* set or clear breakpoint in the relevant control op */ + size_t off = SvUVX(*svp); + size_t sz = off+8/8; + if (sz <= PL_breakpointslen) { + /* set or clear breakpoint */ if (SvTRUE(sv)) - o->op_flags |= OPf_SPECIAL; + PL_breakpoints[off/8] |= 1 << off%8; else - o->op_flags &= ~OPf_SPECIAL; -#ifdef PERL_DEBUG_READONLY_OPS - Slab_to_ro(OpSLAB(o)); -#endif + PL_breakpoints[off/8] &= ~(U8)(1 << off%8); } } return 0; @@ -5922,12 +5922,28 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) flags &= ~SVf_UTF8; - NewOp(1101, cop, 1, COP); if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) { + size_t sz, seq; + NewOp(1101, *(struct dbop **)&cop, 1, struct dbop); cop->op_type = OP_DBSTATE; cop->op_ppaddr = PL_ppaddr[ OP_DBSTATE ]; + OP_REFCNT_LOCK; + sz = PL_breakpointseq+8/8; + if (!PL_breakpoints) { + PL_breakpoints = (U8 *)PerlMemShared_malloc(sz); + PL_breakpointslen = sz; + } + else if (PL_breakpointslen < sz) { + PL_breakpoints = + (U8 *)PerlMemShared_realloc(PL_breakpoints,sz); + PL_breakpointslen = sz; + } + seq = ((struct dbop *)cop)->dbop_seq = PL_breakpointseq++; + PL_breakpoints[seq/8] &= ~(U8)(1 << seq%8); + OP_REFCNT_UNLOCK; } else { + NewOp(1101, cop, 1, COP); cop->op_type = OP_NEXTSTATE; cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ]; } @@ -5972,13 +5988,13 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o) CopSTASH_set(cop, PL_curstash); if (cop->op_type == OP_DBSTATE) { - /* this line can have a breakpoint - store the cop in IV */ + /* this line can have a breakpoint - store the dbop seq in IV */ AV *av = CopFILEAVx(PL_curcop); if (av) { SV * const * const svp = av_fetch(av, CopLINE(cop), FALSE); if (svp && *svp != &PL_sv_undef ) { (void)SvIOK_on(*svp); - SvIV_set(*svp, PTR2IV(cop)); + SvUV_set(*svp, ((struct dbop *)cop)->dbop_seq); } } } @@ -101,6 +101,12 @@ END_EXTERN_C #undef PL_appctx #define PL_appctx (*Perl_Gappctx_ptr(NULL)) +#undef PL_breakpoints +#define PL_breakpoints (*Perl_Gbreakpoints_ptr(NULL)) +#undef PL_breakpointseq +#define PL_breakpointseq (*Perl_Gbreakpointseq_ptr(NULL)) +#undef PL_breakpointslen +#define PL_breakpointslen (*Perl_Gbreakpointslen_ptr(NULL)) #undef PL_check #define PL_check (*Perl_Gcheck_ptr(NULL)) #undef PL_check_mutex diff --git a/perlvars.h b/perlvars.h index aa724e8084..56cb96ccd8 100644 --- a/perlvars.h +++ b/perlvars.h @@ -237,3 +237,7 @@ PERLVAR(G, malloc_mutex, perl_mutex) /* Mutex for malloc */ PERLVARI(G, hash_seed_set, bool, FALSE) /* perl.c */ PERLVARA(G, hash_seed, PERL_HASH_SEED_BYTES, unsigned char) /* perl.c and hv.h */ + +PERLVARI(G, breakpoints, U8 *, NULL) /* For setting DB breakpoints */ +PERLVARI(G, breakpointslen, size_t, 0) +PERLVARI(G, breakpointseq, size_t, 0) @@ -1929,6 +1929,7 @@ PP(pp_reset) PP(pp_dbstate) { dVAR; + size_t const seq = ((struct dbop *)PL_op)->dbop_seq; PL_curcop = (COP*)PL_op; TAINT_NOT; /* Each statement is presumed innocent */ PL_stack_sp = PL_stack_base + cxstack[cxstack_ix].blk_oldsp; @@ -1936,7 +1937,8 @@ PP(pp_dbstate) PERL_ASYNC_CHECK(); - if (PL_op->op_flags & OPf_SPECIAL /* breakpoint */ + assert(seq+8/8 <= PL_breakpointslen); + if (PL_breakpoints[seq/8] & 1 << seq%8 || SvIV(PL_DBsingle) || SvIV(PL_DBsignal) || SvIV(PL_DBtrace)) { dSP; diff --git a/t/run/switchd.t b/t/run/switchd.t index f901bf620e..68a97d635c 100644 --- a/t/run/switchd.t +++ b/t/run/switchd.t @@ -9,7 +9,7 @@ BEGIN { require "./test.pl"; } # This test depends on t/lib/Devel/switchd*.pm. -plan(tests => 17); +plan(tests => 18); my $r; @@ -253,3 +253,20 @@ is( "ok\n", "setting breakpoints without *DB::dbline aliased" ); + +# Test setting breakpoints after overwriting source lines +is( + runperl( + switches => [ '-Ilib', '-d:switchd_empty' ], + progs => [ split "\n", + '*DB::dbline = *{q(_<).__FILE__}; + $DB::dbline[1] = 7; # IVX used to point to the cop address + $DB::dbline{1} = 1; # crash accessing cCOPx(7)->op_flags + print qq[ok\n]; + ' + ], + stderr => 1 + ), + "ok\n", + 'no crash when setting $DB::dbline{1} after $DB::dbline[1]' +); |