add PL_curstackinfo->si_stack_hwm
authorDavid Mitchell <davem@iabyn.com>
Tue, 13 Jun 2017 08:11:13 +0000 (09:11 +0100)
committerDavid Mitchell <davem@iabyn.com>
Sat, 24 Jun 2017 08:38:14 +0000 (09:38 +0100)
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.

cop.h
dump.c
pp.h
pp_hot.c
scope.c

diff --git a/cop.h b/cop.h
index 0443e24..42257c7 100644 (file)
--- 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 7cdebfe..b950929 100644 (file)
--- 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 16cb937..e763b2e 100644 (file)
--- 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) \
index 0ff3d5b..43ac8a7 100644 (file)
--- 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 a7c17e8..59cea3b 100644 (file)
--- 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;
 }