In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/87058c31e9fa350bda8d797127c9c175d0b1a893?hp=23c687d9d091a545afb2b769447c17fba98ba87a>
- Log ----------------------------------------------------------------- commit 87058c31e9fa350bda8d797127c9c175d0b1a893 Author: David Mitchell <[email protected]> Date: Tue Jun 13 09:11:13 2017 +0100 add PL_curstackinfo->si_stack_hwm On debugging builds only, add a mechanism for checking pp function calls for insufficient stack extending. It works by: * make the runops loop set a high-water-mark (HWM) variable equal to PL_stack_sp just before calling each pp function; * make EXTEND() etc update this HWM; * on return from the pp function, panic if PL_stack_sp is > HWM. This detects whether pp functions are pushing more items onto the stack than they are requesting space for. There's a possibility of false positives if the code is doing weird stuff like direct manipulation of stacks via PL_curstack, SWITCHSTACK() etc. It's also possible that one pp function "knows" that a previous pp function will have already grown the stack enough. Currently the only place in core that seems to do this is pp_enteriter, which allocates 1 stack slot so that pp_iter doesn't have to check each time it returns &PL_sv_yes/no. To accommodate this, the new macro EXTEND_SKIP() has been added, that tells perl that it's safely skipping an EXTEND() here. ----------------------------------------------------------------------- Summary of changes: cop.h | 13 +++++++++++++ dump.c | 19 ++++++++++++++++++- pp.h | 36 +++++++++++++++++++++++++++++++++++- pp_hot.c | 2 +- scope.c | 4 ++++ 5 files changed, 71 insertions(+), 3 deletions(-) diff --git a/cop.h b/cop.h index 0443e24c66..42257c7e4e 100644 --- a/cop.h +++ b/cop.h @@ -994,6 +994,12 @@ struct stackinfo { I32 si_markoff; /* offset where markstack begins for us. * currently used only with DEBUGGING, * but not #ifdef-ed for bincompat */ +#ifdef DEBUGGING && !defined DEBUGGING_RE_ONLY +/* high water mark: for checking if the stack was correctly extended / + * tested for extension by each pp function */ + SSize_t si_stack_hwm; +#endif + }; typedef struct stackinfo PERL_SI; @@ -1009,6 +1015,12 @@ typedef struct stackinfo PERL_SI; # define SET_MARK_OFFSET NOOP #endif +#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY +# define PUSHSTACK_INIT_HWM(si) si->si_stack_hwm = 0 +#else +# define PUSHSTACK_INIT_HWM(si) NOOP +#endif + #define PUSHSTACKi(type) \ STMT_START { \ PERL_SI *next = PL_curstackinfo->si_next; \ @@ -1024,6 +1036,7 @@ typedef struct stackinfo PERL_SI; } \ next->si_type = type; \ next->si_cxix = -1; \ + PUSHSTACK_INIT_HWM(next); \ AvFILLp(next->si_stack) = 0; \ SWITCHSTACK(PL_curstack,next->si_stack); \ PL_curstackinfo = next; \ diff --git a/dump.c b/dump.c index 7cdebfe875..b95092956f 100644 --- a/dump.c +++ b/dump.c @@ -2413,15 +2413,29 @@ Perl_sv_dump(pTHX_ SV *sv) int Perl_runops_debug(pTHX) { +#ifdef DEBUGGING && !defined DEBUGGING_RE_ONLY + SSize_t orig_stack_hwm = PL_curstackinfo->si_stack_hwm; + + PL_curstackinfo->si_stack_hwm = PL_stack_sp - PL_stack_base; +#endif + if (!PL_op) { Perl_ck_warner_d(aTHX_ packWARN(WARN_DEBUGGING), "NULL OP IN RUN"); return 0; } - DEBUG_l(Perl_deb(aTHX_ "Entering new RUNOPS level\n")); do { #ifdef PERL_TRACE_OPS ++PL_op_exec_cnt[PL_op->op_type]; +#endif +#ifdef DEBUGGING && !defined DEBUGGING_RE_ONLY + if (PL_curstackinfo->si_stack_hwm < PL_stack_sp - PL_stack_base) + Perl_croak_nocontext( + "panic: previous op failed to extend arg stack: " + "base=%p, sp=%p, hwm=%p\n", + PL_stack_base, PL_stack_sp, + PL_stack_base + PL_curstackinfo->si_stack_hwm); + PL_curstackinfo->si_stack_hwm = PL_stack_sp - PL_stack_base; #endif if (PL_debug) { ENTER; @@ -2452,6 +2466,9 @@ Perl_runops_debug(pTHX) DEBUG_l(Perl_deb(aTHX_ "leaving RUNOPS level\n")); PERL_ASYNC_CHECK(); +#ifdef DEBUGGING && !defined DEBUGGING_RE_ONLY + PL_curstackinfo->si_stack_hwm = orig_stack_hwm; +#endif TAINT_NOT; return 0; } diff --git a/pp.h b/pp.h index 16cb937d18..e763b2e72a 100644 --- a/pp.h +++ b/pp.h @@ -295,6 +295,20 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>. =cut */ +/* EXTEND_HWM_SET: note the high-water-mark to which the stack has been + * requested to be extended (which is likely to be less than PL_stack_max) + */ +#if defined DEBUGGING && !defined DEBUGGING_RE_ONLY +# define EXTEND_HWM_SET(p, n) \ + STMT_START { \ + SSize_t ix = (p) - PL_stack_base + (n); \ + if (ix > PL_curstackinfo->si_stack_hwm) \ + PL_curstackinfo->si_stack_hwm = ix; \ + } STMT_END +#else +# define EXTEND_HWM_SET(p, n) NOOP +#endif + /* _EXTEND_SAFE_N(n): private helper macro for EXTEND(). * Tests whether the value of n would be truncated when implicitly cast to * SSize_t as an arg to stack_grow(). If so, sets it to -1 instead to @@ -306,6 +320,8 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>. (sizeof(n) > sizeof(SSize_t) && ((SSize_t)(n) != (n)) ? -1 : (n)) #ifdef STRESS_REALLOC +# define EXTEND_SKIP(p, n) EXTEND_HWM_SET(p, n) + # define EXTEND(p,n) STMT_START { \ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ PERL_UNUSED_VAR(sp); \ @@ -335,15 +351,32 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>. * this just gives a safe false positive */ -# define _EXTEND_NEEDS_GROW(p,n) ( (n) < 0 || PL_stack_max - p < (n)) +# define _EXTEND_NEEDS_GROW(p,n) ((n) < 0 || PL_stack_max - p < (n)) + + +/* EXTEND_SKIP(): used for where you would normally call EXTEND(), but + * you know for sure that a previous op will have already extended the + * stack sufficiently. For example pp_enteriter ensures that that there + * is always at least 1 free slot, so pp_iter can return &PL_sv_yes/no + * without checking each time. Calling EXTEND_SKIP() defeats the HWM + * debugging mechanism which would otherwise whine + */ + +# define EXTEND_SKIP(p, n) STMT_START { \ + EXTEND_HWM_SET(p, n); \ + assert(!_EXTEND_NEEDS_GROW(p,n)); \ + } STMT_END + # define EXTEND(p,n) STMT_START { \ + EXTEND_HWM_SET(p, n); \ if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ PERL_UNUSED_VAR(sp); \ } } STMT_END /* Same thing, but update mark register too. */ # define MEXTEND(p,n) STMT_START { \ + EXTEND_HWM_SET(p, n); \ if (UNLIKELY(_EXTEND_NEEDS_GROW(p,n))) { \ const SSize_t markoff = mark - PL_stack_base;\ sp = stack_grow(sp,p,_EXTEND_SAFE_N(n)); \ @@ -352,6 +385,7 @@ Does not use C<TARG>. See also C<L</XPUSHu>>, C<L</mPUSHu>> and C<L</PUSHu>>. } } STMT_END #endif + /* set TARG to the IV value i. If do_taint is false, * assume that PL_tainted can never be true */ #define TARGi(i, do_taint) \ diff --git a/pp_hot.c b/pp_hot.c index 0ff3d5b48b..43ac8a7e89 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -3037,7 +3037,7 @@ PP(pp_iter) retsv = &PL_sv_no; } /* pp_enteriter should have pre-extended the stack */ - assert(PL_stack_sp < PL_stack_max); + EXTEND_SKIP(PL_stack_sp, 1); *++PL_stack_sp =retsv; return PL_op->op_next; diff --git a/scope.c b/scope.c index a7c17e8d9e..59cea3b985 100644 --- a/scope.c +++ b/scope.c @@ -55,6 +55,10 @@ Perl_stack_grow(pTHX_ SV **sp, SV **p, SSize_t n) Perl_croak(aTHX_ "Out of memory during stack extend"); av_extend(PL_curstack, current + n + extra); +#ifdef DEBUGGING + PL_curstackinfo->si_stack_hwm = current + n + extra; +#endif + return PL_stack_sp; } -- Perl5 Master Repository
