In perl.git, the branch smoke-me/debug_readonly_ops has been updated <http://perl5.git.perl.org/perl.git/commitdiff/b19b3d9d94c45c0080c8aaccbe057ac1160095d6?hp=d787f4a5ba95039e3f0b8f63ebc649cde1011c69>
- Log ----------------------------------------------------------------- commit b19b3d9d94c45c0080c8aaccbe057ac1160095d6 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 ce81123c4d3004d7159670eb72f26251587406e2 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 2ad420f463da20c3465f3d09c5c7eea7f0b2c8f2 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 65c89bb7fb34243bc5a89b081bf7329e5a60e597 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 ++++++++++++++++++++++++------------ pp.c | 4 ++-- proto.h | 12 +++++------- 6 files changed, 39 insertions(+), 29 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/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
