This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
add CX_POP(cx) macro: glorified cxstack_ix--
authorDavid Mitchell <davem@iabyn.com>
Thu, 15 Oct 2015 16:46:31 +0000 (17:46 +0100)
committerDavid Mitchell <davem@iabyn.com>
Wed, 3 Feb 2016 08:59:44 +0000 (08:59 +0000)
but with extra checking goodness on debugging builds.

cop.h
pp_ctl.c
pp_hot.c
pp_sort.c
pp_sys.c

diff --git a/cop.h b/cop.h
index 3c57540..b79ae27 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -574,6 +574,19 @@ struct block_format {
 
 #define CX_LEAVE_SCOPE(cx) LEAVE_SCOPE(cx->cx_old_savestack_ix)
 
+#ifdef DEBUGGING
+/* on debugging builds, poison cx afterwards so we know no code
+ * uses it - because after doing cxstack_ix--, any ties, exceptions etc
+ * may overwrite the current stack frame */
+#  define CX_POP(cx)                                                   \
+        assert(&cxstack[cxstack_ix] == cx);                            \
+        cxstack_ix--;                                                  \
+        cx = NULL;
+#else
+#  define CX_POP(cx) cxstack_ix--;
+#endif
+
+
 /* base for the next two macros. Don't use directly.
  * The context frame holds a reference to the CV so that it can't be
  * freed while we're executing it */
@@ -1298,12 +1311,12 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        cx = &cxstack[cxstack_ix];                                      \
        CX_LEAVE_SCOPE(cx);                                             \
         POPSUB_COMMON(cx);                                              \
-       POPBLOCK(cx);                                                   \
         newsp = PL_stack_base + cx->blk_oldsp;                          \
         gimme = cx->blk_gimme;                                          \
         PERL_UNUSED_VAR(newsp); /* for API */                           \
         PERL_UNUSED_VAR(gimme); /* for API */                           \
-       cxstack_ix--;                                                   \
+       POPBLOCK(cx);                                                   \
+       CX_POP(cx);                                                     \
        POPSTACK;                                                       \
        CATCH_SET(multicall_oldcatch);                                  \
        SPAGAIN;                                                        \
index 23f6cce..83082af 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -288,7 +288,7 @@ PP(pp_substcont)
 
            CX_LEAVE_SCOPE(cx);
            POPSUBST(cx);
-            cxstack_ix--;
+            CX_POP(cx);
 
            PERL_ASYNC_CHECK();
            RETURNOP(pm->op_next);
@@ -1666,13 +1666,13 @@ Perl_die_unwind(pTHX_ SV *msv)
             CX_LEAVE_SCOPE(cx);
            POPEVAL(cx);
            POPBLOCK(cx);
-            cxstack_ix--;
            namesv = cx->blk_eval.old_namesv;
 #ifdef DEBUGGING
            oldcop = cx->blk_oldcop;
 #endif
            restartjmpenv = cx->blk_eval.cur_top_env;
            restartop = cx->blk_eval.retop;
+            CX_POP(cx);
 
            if (optype == OP_REQUIRE) {
                 assert (PL_curcop == oldcop);
@@ -2102,7 +2102,7 @@ PP(pp_leave)
     CX_LEAVE_SCOPE(cx);
     POPBASICBLK(cx);
     POPBLOCK(cx);
-    cxstack_ix--;
+    CX_POP(cx);
 
     return NORMAL;
 }
@@ -2279,7 +2279,7 @@ PP(pp_leaveloop)
     CX_LEAVE_SCOPE(cx);
     POPLOOP(cx);       /* Stack values are safe: release loop vars ... */
     POPBLOCK(cx);
-    cxstack_ix--;
+    CX_POP(cx);
 
     return NORMAL;
 }
@@ -2302,6 +2302,7 @@ PP(pp_leavesublv)
     PERL_CONTEXT *cx;
     bool ref;
     const char *what = NULL;
+    OP *retop;
 
     cx = &cxstack[cxstack_ix];
     assert(CxTYPE(cx) == CXt_SUB);
@@ -2405,9 +2406,10 @@ PP(pp_leavesublv)
     CX_LEAVE_SCOPE(cx);
     POPSUB(cx);        /* Stack values are safe: release CV and @_ ... */
     POPBLOCK(cx);
-    cxstack_ix--;
+    retop =  cx->blk_sub.retop;
+    CX_POP(cx);
 
-    return cx->blk_sub.retop;
+    return retop;
 }
 
 
@@ -2562,6 +2564,7 @@ S_unwind_loop(pTHX_ const char * const opname)
 PP(pp_last)
 {
     PERL_CONTEXT *cx;
+    OP* nextop;
 
     S_unwind_loop(aTHX_ "last");
 
@@ -2581,9 +2584,10 @@ PP(pp_last)
     CX_LEAVE_SCOPE(cx);
     POPLOOP(cx);       /* release loop vars ... */
     POPBLOCK(cx);
-    cxstack_ix--;
+    nextop = cx->blk_loop.my_op->op_lastop->op_next;
+    CX_POP(cx);
 
-    return cx->blk_loop.my_op->op_lastop->op_next;
+    return nextop;
 }
 
 PP(pp_next)
@@ -2854,7 +2858,7 @@ PP(pp_goto)
                  * this is a POPBLOCK(), less all the stuff we already did
                  * for TOPBLOCK() earlier */
                 PL_curcop = cx->blk_oldcop;
-               cxstack_ix--;
+                CX_POP(cx);
 
                /* Push a mark for the start of arglist */
                PUSHMARK(mark);
@@ -3426,7 +3430,6 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
        SV *namesv;
         SV *errsv = NULL;
 
-       cx = NULL;
        namesv = NULL;
        PERL_UNUSED_VAR(optype);
 
@@ -3443,15 +3446,14 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
             CX_LEAVE_SCOPE(cx);
            POPEVAL(cx);
            POPBLOCK(cx);
-            cxstack_ix--;
            namesv = cx->blk_eval.old_namesv;
+            CX_POP(cx);
        }
 
        errsv = ERRSV;
        if (in_require) {
-           if (!cx) {
-               /* If cx is still NULL, it means that we didn't go in the
-                * POPEVAL branch. */
+            if (yystatus == 3) {
+               /* we didn't go in the POPEVAL branch. */
                cx = &cxstack[cxstack_ix];
                assert(CxTYPE(cx) == CXt_EVAL);
                namesv = cx->blk_eval.old_namesv;
@@ -4290,10 +4292,10 @@ PP(pp_leaveeval)
     CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
     POPBLOCK(cx);
-    cxstack_ix--;
     namesv = cx->blk_eval.old_namesv;
     retop = cx->blk_eval.retop;
     evalcv = cx->blk_eval.cv;
+    CX_POP(cx);
 
 
 #ifdef DEBUGGING
@@ -4333,7 +4335,7 @@ Perl_delete_eval_scope(pTHX)
     CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
     POPBLOCK(cx);
-    cxstack_ix--;
+    CX_POP(cx);
     PERL_UNUSED_VAR(optype);
 }
 
@@ -4389,8 +4391,8 @@ PP(pp_leavetry)
     CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
     POPBLOCK(cx);
-    cxstack_ix--;
     retop = cx->blk_eval.retop;
+    CX_POP(cx);
     PERL_UNUSED_VAR(optype);
 
     CLEAR_ERRSV();
@@ -4434,7 +4436,7 @@ PP(pp_leavegiven)
     CX_LEAVE_SCOPE(cx);
     POPGIVEN(cx);
     POPBLOCK(cx);
-    cxstack_ix--;
+    CX_POP(cx);
 
     return NORMAL;
 }
@@ -5040,6 +5042,7 @@ PP(pp_continue)
 {
     I32 cxix;
     PERL_CONTEXT *cx;
+    OP *nextop;
     
     cxix = dopoptowhen(cxstack_ix); 
     if (cxix < 0)   
@@ -5054,9 +5057,10 @@ PP(pp_continue)
     CX_LEAVE_SCOPE(cx);
     POPWHEN(cx);
     POPBLOCK(cx);
-    cxstack_ix--;
+    nextop = cx->blk_givwhen.leave_op->op_next;
+    CX_POP(cx);
 
-    return cx->blk_givwhen.leave_op->op_next;
+    return nextop;
 }
 
 PP(pp_break)
index 5f2523c..013eb98 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3273,6 +3273,7 @@ PP(pp_leavesub)
     SV **newsp;
     I32 gimme;
     PERL_CONTEXT *cx;
+    OP *retop;
 
     cx = &cxstack[cxstack_ix];
     assert(CxTYPE(cx) == CXt_SUB);
@@ -3339,9 +3340,10 @@ PP(pp_leavesub)
     CX_LEAVE_SCOPE(cx);
     POPSUB(cx);        /* Stack values are safe: release CV and @_ ... */
     POPBLOCK(cx);
-    cxstack_ix--;
+    retop = cx->blk_sub.retop;
+    CX_POP(cx);
 
-    return cx->blk_sub.retop;
+    return retop;
 }
 
 
index 8a4bb0f..5ccdaca 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1713,7 +1713,7 @@ PP(pp_sort)
                 /* there isn't a POPNULL ! */
 
            POPBLOCK(cx);
-            cxstack_ix--;
+            CX_POP(cx);
            POPSTACK;
            CATCH_SET(oldcatch);
        }
index be4dec4..0792727 100644 (file)
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1527,7 +1527,7 @@ PP(pp_leavewrite)
     POPFORMAT(cx);
     POPBLOCK(cx);
     retop = cx->blk_sub.retop;
-    cxstack_ix--;
+    CX_POP(cx);
 
     if (is_return)
         /* XXX the semantics of doing 'return' in a format aren't documented.