summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cop.h17
-rw-r--r--pp_ctl.c44
-rw-r--r--pp_hot.c6
-rw-r--r--pp_sort.c2
-rw-r--r--pp_sys.c2
5 files changed, 45 insertions, 26 deletions
diff --git a/cop.h b/cop.h
index 3c57540977..b79ae27c9c 100644
--- 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; \
diff --git a/pp_ctl.c b/pp_ctl.c
index 23f6cceafa..83082afe1f 100644
--- 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)
diff --git a/pp_hot.c b/pp_hot.c
index 5f2523ca37..013eb981e6 100644
--- 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;
}
diff --git a/pp_sort.c b/pp_sort.c
index 8a4bb0f759..5ccdacaf08 100644
--- 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);
}
diff --git a/pp_sys.c b/pp_sys.c
index be4dec4f6a..0792727ed6 100644
--- 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.
View Lorry Controller Status