In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b4503eb21cec03c71afa02337811838b7d5e4e8e?hp=2d1c5561244ffb488f4901ad84c08f3fc6443be9>
- Log ----------------------------------------------------------------- commit b4503eb21cec03c71afa02337811838b7d5e4e8e Merge: 2d1c556 f3e2910 Author: Nicholas Clark <[email protected]> Date: Tue Sep 4 12:07:35 2012 +0200 Merge improvements to -DPERL_DEBUG_READONLY_OPS into blead. All tests pass with -Dusethreads -DPERL_DEBUG_READONLY_OPS (on this system) commit f3e2910579399afd7e086e660f40c5b6793d30a8 Author: Nicholas Clark <[email protected]> Date: Tue Sep 4 11:54:06 2012 +0200 In Perl_cv_forget_slab(), simplify the conditionally compiled code. This refactoring reduces the line count and makes it clear that the basic logic is the same with or without -DPERL_DEBUG_READONLY_OPS. It make no change to the generated assembler on a normal build. M pad.c commit 7bbbc3c08a8830fe5d44ce7a6056cfba6fb67c22 Author: Nicholas Clark <[email protected]> Date: Mon Sep 3 16:47:15 2012 +0200 Perl_magic_setdbline() should clear and set read-only OP slabs. The debugger implements breakpoints by setting/clearing OPf_SPECIAL on OP_DBSTATE ops. This means that it is writing to the optree at runtime, and it falls foul of the enforced read-only OP slabs when debugging with -DPERL_DEBUG_READONLY_OPS Avoid this by removing static from Slab_to_rw(), and using it and Slab_to_ro() in Perl_magic_setdbline() to temporarily make the slab re-write whilst changing the breakpoint flag. With this all tests pass with -DPERL_DEBUG_READONLY_OPS (on this system) M embed.fnc M embed.h M mg.c M op.c M proto.h commit 83519873101c5088b6e33e85da400d6f575c0ceb Author: Nicholas Clark <[email protected]> Date: Tue Aug 14 14:24:34 2012 +0200 In op.c, change S_Slab_to_rw() from an OP * parameter to an OPSLAB *. This makes it consistent with Perl_Slab_to_ro(), which takes an OPSLAB *. M embed.fnc M op.c M proto.h commit 372eab0142c6ca32a90d09218d73cf03c96f35b3 Author: Nicholas Clark <[email protected]> Date: Tue Aug 14 14:10:30 2012 +0200 With -DPERL_DEBUG_READONLY_OPS, changing a slab refcnt shouldn't make it r/w. Perl_op_refcnt_inc() and Perl_op_refcnt_dec() now both take care to leave the slab in the same state as they found it. Previously both would unconditionally make the slab read-write. M op.c commit a5bd31f4dc3fec64e60f1412a4eeac30d6f6b96b Author: Nicholas Clark <[email protected]> Date: Wed Aug 8 12:37:48 2012 +0200 Under -DPERL_DEBUG_READONLY_OPS don't work around glibc 2.2.5 _moddi3 bugs. The work around involves a runtime check and substituting OP pointers based on the result. The substitution fails if the optree is mapped read-only. M pp.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 4 +--- embed.h | 6 +----- mg.c | 6 ++++++ op.c | 36 ++++++++++++++++++++++++------------ pad.c | 16 +++++----------- pp.c | 4 ++-- proto.h | 12 +++++------- 7 files changed, 44 insertions(+), 40 deletions(-) diff --git a/embed.fnc b/embed.fnc index f547316..ab2cdec 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1797,14 +1797,12 @@ Xp |void |Slab_Free |NN void *op #if defined(PERL_DEBUG_READONLY_OPS) # if defined(PERL_CORE) px |void |Slab_to_ro |NN OPSLAB *slab +px |void |Slab_to_rw |NN OPSLAB *const slab # endif : Used in OpREFCNT_inc() in sv.c poxM |OP * |op_refcnt_inc |NULLOK OP *o : FIXME - can be static. poxM |PADOFFSET |op_refcnt_dec |NN OP *o -# if defined(PERL_IN_OP_C) -s |void |Slab_to_rw |NN void *op -# endif #endif #if defined(PERL_IN_PERL_C) diff --git a/embed.h b/embed.h index ecce321..45291f0 100644 --- a/embed.h +++ b/embed.h @@ -1319,6 +1319,7 @@ #define opslab_free_nopad(a) Perl_opslab_free_nopad(aTHX_ a) # if defined(PERL_DEBUG_READONLY_OPS) #define Slab_to_ro(a) Perl_Slab_to_ro(aTHX_ a) +#define Slab_to_rw(a) Perl_Slab_to_rw(aTHX_ a) # endif # endif # if defined(PERL_CR_FILTER) @@ -1327,11 +1328,6 @@ #define strip_return(a) S_strip_return(aTHX_ a) # endif # endif -# if defined(PERL_DEBUG_READONLY_OPS) -# if defined(PERL_IN_OP_C) -#define Slab_to_rw(a) S_Slab_to_rw(aTHX_ a) -# endif -# endif # if defined(PERL_IN_AV_C) #define get_aux_mg(a) S_get_aux_mg(aTHX_ a) # endif diff --git a/mg.c b/mg.c index 3dea5c2..1f6d062 100644 --- a/mg.c +++ b/mg.c @@ -2020,11 +2020,17 @@ Perl_magic_setdbline(pTHX_ SV *sv, MAGIC *mg) 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 */ if (i) o->op_flags |= OPf_SPECIAL; else o->op_flags &= ~OPf_SPECIAL; +#ifdef PERL_DEBUG_READONLY_OPS + Slab_to_ro(OpSLAB(o)); +#endif } } return 0; diff --git a/op.c b/op.c index 7305ab5..9ad4499 100644 --- a/op.c +++ b/op.c @@ -261,18 +261,13 @@ Perl_Slab_to_ro(pTHX_ OPSLAB *slab) } } -STATIC void -S_Slab_to_rw(pTHX_ void *op) +void +Perl_Slab_to_rw(pTHX_ OPSLAB *const slab) { - OP * const o = (OP *)op; - OPSLAB *slab; OPSLAB *slab2; PERL_ARGS_ASSERT_SLAB_TO_RW; - if (!o->op_slabbed) return; - - slab = OpSLAB(o); if (!slab->opslab_readonly) return; slab2 = slab; for (; slab2; slab2 = slab2->opslab_next) { @@ -406,8 +401,14 @@ OP * Perl_op_refcnt_inc(pTHX_ OP *o) { if(o) { - Slab_to_rw(o); - ++o->op_targ; + OPSLAB *const slab = o->op_slabbed ? OpSLAB(o) : NULL; + if (slab && slab->opslab_readonly) { + Slab_to_rw(slab); + ++o->op_targ; + Slab_to_ro(slab); + } else { + ++o->op_targ; + } } return o; @@ -416,9 +417,19 @@ Perl_op_refcnt_inc(pTHX_ OP *o) PADOFFSET Perl_op_refcnt_dec(pTHX_ OP *o) { + PADOFFSET result; + OPSLAB *const slab = o->op_slabbed ? OpSLAB(o) : NULL; + PERL_ARGS_ASSERT_OP_REFCNT_DEC; - Slab_to_rw(o); - return --o->op_targ; + + if (slab && slab->opslab_readonly) { + Slab_to_rw(slab); + result = --o->op_targ; + Slab_to_ro(slab); + } else { + result = --o->op_targ; + } + return result; } #endif /* @@ -698,7 +709,8 @@ Perl_op_free(pTHX_ OP *o) if (type == OP_NULL) type = (OPCODE)o->op_targ; - Slab_to_rw(o); + if (o->op_slabbed) + Slab_to_rw(OpSLAB(o)); /* COP* is not cleared by op_clear() so that we may track line * numbers etc even after null() */ diff --git a/pad.c b/pad.c index 148fdf8..aba463b 100644 --- a/pad.c +++ b/pad.c @@ -505,9 +505,7 @@ void Perl_cv_forget_slab(pTHX_ CV *cv) { const bool slabbed = !!CvSLABBED(cv); -#ifdef PERL_DEBUG_READONLY_OPS OPSLAB *slab = NULL; -#endif PERL_ARGS_ASSERT_CV_FORGET_SLAB; @@ -515,25 +513,21 @@ Perl_cv_forget_slab(pTHX_ CV *cv) CvSLABBED_off(cv); -#ifdef PERL_DEBUG_READONLY_OPS if (CvROOT(cv)) slab = OpSLAB(CvROOT(cv)); else if (CvSTART(cv)) slab = (OPSLAB *)CvSTART(cv); -#else - if (CvROOT(cv)) OpslabREFCNT_dec(OpSLAB(CvROOT(cv))); - else if (CvSTART(cv)) OpslabREFCNT_dec((OPSLAB *)CvSTART(cv)); -#endif #ifdef DEBUGGING else if (slabbed) Perl_warn(aTHX_ "Slab leaked from cv %p", cv); #endif -#ifdef PERL_DEBUG_READONLY_OPS if (slab) { - size_t refcnt; - refcnt = slab->opslab_refcnt; +#ifdef PERL_DEBUG_READONLY_OPS + const size_t refcnt = slab->opslab_refcnt; +#endif OpslabREFCNT_dec(slab); +#ifdef PERL_DEBUG_READONLY_OPS if (refcnt > 1) Slab_to_ro(slab); - } #endif + } } /* diff --git a/pp.c b/pp.c index 05a9edf..29db8ed 100644 --- a/pp.c +++ b/pp.c @@ -2364,7 +2364,7 @@ PP(pp_i_divide) } } -#if defined(__GLIBC__) && IVSIZE == 8 +#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) STATIC PP(pp_i_modulo_0) #else @@ -2387,7 +2387,7 @@ PP(pp_i_modulo) } } -#if defined(__GLIBC__) && IVSIZE == 8 +#if defined(__GLIBC__) && IVSIZE == 8 && !defined(PERL_DEBUG_READONLY_OPS) STATIC PP(pp_i_modulo_1) diff --git a/proto.h b/proto.h index 7670835..f97fe1f 100644 --- a/proto.h +++ b/proto.h @@ -5304,6 +5304,11 @@ PERL_CALLCONV void Perl_Slab_to_ro(pTHX_ OPSLAB *slab) #define PERL_ARGS_ASSERT_SLAB_TO_RO \ assert(slab) +PERL_CALLCONV void Perl_Slab_to_rw(pTHX_ OPSLAB *const slab) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_SLAB_TO_RW \ + assert(slab) + # endif #endif #if defined(PERL_CR_FILTER) @@ -5323,13 +5328,6 @@ PERL_CALLCONV PADOFFSET Perl_op_refcnt_dec(pTHX_ OP *o) assert(o) PERL_CALLCONV OP * Perl_op_refcnt_inc(pTHX_ OP *o); -# if defined(PERL_IN_OP_C) -STATIC void S_Slab_to_rw(pTHX_ void *op) - __attribute__nonnull__(pTHX_1); -#define PERL_ARGS_ASSERT_SLAB_TO_RW \ - assert(op) - -# endif #endif #if defined(PERL_DEFAULT_DO_EXEC3_IMPLEMENTATION) /* PERL_CALLCONV bool Perl_do_exec(pTHX_ const char* cmd) -- Perl5 Master Repository
