reverse the order of POPBLOCK; POPFOO

Currently most pp_leavefoo subs have something along the lines of

    POPBLOCK(cx);
    POPFOO(cx);

where POPBLOCK does cxstack_ix-- and sets cx to point to the top CX stack
entry. It then restores a bunch of PL_ vars saved in the CX struct.

Then POPFOO does any type-specific restoration, e.g. POPSUB decrements the
ref count of the cv that was just executed.

However, this is logically the wrong order. When we *enter* a scope, we do

    PUSHBLOCK;
    PUSHFOO;

so undoing the PUSHBLOCK should be the last thing we do.  As it happens,
it doesn't really make any difference to the running, which is why we've
never fixed it before.

Reordering it has two advantages.

First, it allows the steps for scope exit to be the exact logical reverse
of scope exit, which makes understanding what's going on and debugging
easier.

It allows us to make the code cleaner.

This commit also removes the cxstack_ix-- and setting cx steps from
POPBLOCK; now we already expect cx to be set (which it usually already is)
and we do the cxstack_ix-- ourselves. This also means we can remove a
whole bunch of cxstack_ix++'s that were added immediately after the
POPBLOCK in order to prevent the context being inadvertently overwritten
before we've finished using it.

So in full,

    POPBLOCK(cx);
    POPFOO(cx);

is now implemented as:

    cx = &cxstack[cxstack_ix];
    ... other stuff done with cx ...
    POPFOO(cx);
    POPBLOCK(cx);
    cxstack_ix--;

Finally, this commit also tweaks PL_curcop in pp_leaveeval, since
otherwise PL_curcop could temporarily be NULL when debugging code is
called in the presence of 'use re Debug'. It also stops the debugging code
crashing if PL_curcop is still NULL.

6 files changed, 64 insertions, 47 deletions

diff --git a/cop.h b/cop.h
index 8fe3a9d1e4..7078a7a0c9 100644
--- a/cop.h
+++ b/cop.h
@@ -939,7 +939,6 @@ struct block {
 /* Exit a block (RETURN and LAST). */
 #define POPBLOCK(cx,pm)							\
 	DEBUG_CX("POP");						\
-	cx = &cxstack[cxstack_ix--],					\
 	PL_curcop	 = cx->blk_oldcop,				\
 	PL_markstack_ptr = PL_markstack + cx->blk_oldmarksp,		\
 	PL_scopestack_ix = cx->blk_oldscopesp,				\
@@ -1311,15 +1310,16 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
     STMT_START {							\
 	cx = &cxstack[cxstack_ix];					\
         CvDEPTH(multicall_cv) = cx->blk_sub.olddepth;                   \
-	POPBLOCK(cx,PL_curpm);						\
-        /* these two set for backcompat by callers */                   \
-        newsp = PL_stack_base + cx->blk_oldsp;                          \
-        gimme = cx->blk_gimme;                                          \
         /* includes partial unrolled POPSUB(): */                       \
 	CX_LEAVE_SCOPE(cx);                                             \
         PL_comppad = cx->blk_sub.prevcomppad;                           \
         PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;    \
         SvREFCNT_dec_NN(multicall_cv);                                  \
+        /* these two set for backcompat by callers */                   \
+        newsp = PL_stack_base + cx->blk_oldsp;                          \
+        gimme = cx->blk_gimme;                                          \
+	POPBLOCK(cx,PL_curpm);						\
+	cxstack_ix--;                                                   \
 	POPSTACK;							\
 	CATCH_SET(multicall_oldcatch);					\
 	SPAGAIN;							\
diff --git a/pp_ctl.c b/pp_ctl.c
index db7ceb5abf..5e9907cb9e 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1656,8 +1656,9 @@ Perl_die_unwind(pTHX_ SV *msv)
 		my_exit(1);
 	    }
 
-	    POPBLOCK(cx,PL_curpm);
 	    POPEVAL(cx);
+	    POPBLOCK(cx,PL_curpm);
+            cxstack_ix--;
 	    namesv = cx->blk_eval.old_namesv;
 #ifdef DEBUGGING
 	    oldcop = cx->blk_oldcop;
@@ -2076,13 +2077,12 @@ PP(pp_leave)
     PMOP *newpm;
     I32 gimme;
 
-    if (PL_op->op_flags & OPf_SPECIAL) {
-	cx = &cxstack[cxstack_ix];
-	cx->blk_oldpm = PL_curpm;	/* fake block should preserve $1 et al */
-    }
-
     cx = &cxstack[cxstack_ix];
     assert(CxTYPE(cx) == CXt_BLOCK);
+
+    if (PL_op->op_flags & OPf_SPECIAL)
+	cx->blk_oldpm = PL_curpm; /* fake block should preserve $1 et al */
+
     newsp = PL_stack_base + cx->blk_oldsp;
     gimme = cx->blk_gimme;
 
@@ -2092,10 +2092,10 @@ PP(pp_leave)
         leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP,
                                PL_op->op_private & OPpLVALUE);
 
-    POPBLOCK(cx,newpm);
     POPBASICBLK(cx);
-
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
+    cxstack_ix--;
 
     return NORMAL;
 }
@@ -2270,9 +2270,10 @@ PP(pp_leaveloop)
         leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP,
 			       PL_op->op_private & OPpLVALUE);
 
-    POPBLOCK(cx,newpm);
     POPLOOP(cx);	/* Stack values are safe: release loop vars ... */
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;	/* ... and pop $1 et al */
+    cxstack_ix--;
 
     return NORMAL;
 }
@@ -2399,11 +2400,10 @@ PP(pp_leavesublv)
     }
     PUTBACK;
 
-    POPBLOCK(cx,newpm);
-    cxstack_ix++; /* preserve cx entry on stack for use by POPSUB */
     POPSUB(cx);	/* Stack values are safe: release CV and @_ ... */
-    cxstack_ix--;
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;	/* ... and pop $1 et al */
+    cxstack_ix--;
 
     return cx->blk_sub.retop;
 }
@@ -2551,13 +2551,12 @@ S_unwind_loop(pTHX_ const char * const opname)
 PP(pp_last)
 {
     PERL_CONTEXT *cx;
-    OP *nextop = NULL;
     PMOP *newpm;
 
     S_unwind_loop(aTHX_ "last");
 
-    POPBLOCK(cx,newpm);
-    cxstack_ix++; /* temporarily protect top context */
+    cx = &cxstack[cxstack_ix];
+
     assert(
            CxTYPE(cx) == CXt_LOOP_LAZYIV
         || CxTYPE(cx) == CXt_LOOP_LAZYSV
@@ -2565,16 +2564,16 @@ PP(pp_last)
         || CxTYPE(cx) == CXt_LOOP_PLAIN
     );
     PL_stack_sp = PL_stack_base + cx->blk_loop.resetsp;
-    nextop = cx->blk_loop.my_op->op_lastop->op_next;
 
     TAINT_NOT;
 
-    cxstack_ix--;
     /* Stack values are safe: */
     POPLOOP(cx);	/* release loop vars ... */
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;	/* ... and pop $1 et al */
+    cxstack_ix--;
 
-    return nextop;
+    return cx->blk_loop.my_op->op_lastop->op_next;
 }
 
 PP(pp_next)
@@ -3431,8 +3430,10 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
 		PL_eval_root = NULL;
 	    }
 	    SP = PL_stack_base + POPMARK;	/* pop original mark */
-	    POPBLOCK(cx,PL_curpm);
+            cx = &cxstack[cxstack_ix];
 	    POPEVAL(cx);
+	    POPBLOCK(cx,PL_curpm);
+            cxstack_ix--;
 	    namesv = cx->blk_eval.old_namesv;
 	}
 
@@ -4270,13 +4271,21 @@ PP(pp_leaveeval)
         leave_common(newsp, newsp, gimme, SVs_TEMP, FALSE);
         SPAGAIN;
     }
-    POPBLOCK(cx,newpm);
+    /* the POPEVAL does a leavescope, which frees the optree associated
+     * with eval, which if it frees the nextstate associated with
+     * PL_curcop, sets PL_curcop to NULL. Which can mess up freeing a
+     * regex when running under 'use re Debug' because it needs PL_curcop
+     * to get the current hints. So restore it early.
+     */
+    PL_curcop = cx->blk_oldcop;
     POPEVAL(cx);
+    POPBLOCK(cx,newpm);
+    PL_curpm = newpm;	/* Don't pop $1 et al till now */
+    cxstack_ix--;
     namesv = cx->blk_eval.old_namesv;
     retop = cx->blk_eval.retop;
     evalcv = cx->blk_eval.cv;
 
-    PL_curpm = newpm;	/* Don't pop $1 et al till now */
 
 #ifdef DEBUGGING
     assert(CvDEPTH(evalcv) == 1);
@@ -4312,9 +4321,11 @@ Perl_delete_eval_scope(pTHX)
     PERL_CONTEXT *cx;
     I32 optype;
 	
-    POPBLOCK(cx,newpm);
+    cx = &cxstack[cxstack_ix];
     POPEVAL(cx);
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;
+    cxstack_ix--;
     PERL_UNUSED_VAR(optype);
 }
 
@@ -4368,9 +4379,10 @@ PP(pp_leavetry)
         PL_stack_sp = newsp;
     else
         leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+    POPEVAL(cx);
     POPBLOCK(cx,newpm);
+    cxstack_ix--;
     retop = cx->blk_eval.retop;
-    POPEVAL(cx);
     PERL_UNUSED_VAR(optype);
 
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
@@ -4413,11 +4425,10 @@ PP(pp_leavegiven)
         PL_stack_sp = newsp;
     else
         leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
-    POPBLOCK(cx,newpm);
     POPGIVEN(cx);
-    assert(CxTYPE(cx) == CXt_GIVEN);
-
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;	/* Don't pop $1 et al till now */
+    cxstack_ix--;
 
     return NORMAL;
 }
@@ -5021,7 +5032,6 @@ PP(pp_leavewhen)
 
 PP(pp_continue)
 {
-    dSP;
     I32 cxix;
     PERL_CONTEXT *cx;
     PMOP *newpm;
@@ -5034,14 +5044,15 @@ PP(pp_continue)
     if (cxix < cxstack_ix)
         dounwind(cxix);
     
-    POPBLOCK(cx,newpm);
+    cx = &cxstack[cxstack_ix];
     assert(CxTYPE(cx) == CXt_WHEN);
+    PL_stack_sp = PL_stack_base + cx->blk_oldsp;
     POPWHEN(cx);
-
-    SP = PL_stack_base + cx->blk_oldsp;
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;   /* pop $1 et al */
+    cxstack_ix--;
 
-    RETURNOP(cx->blk_givwhen.leave_op->op_next);
+    return cx->blk_givwhen.leave_op->op_next;
 }
 
 PP(pp_break)
diff --git a/pp_hot.c b/pp_hot.c
index b5971f30b5..d686221b45 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3337,11 +3337,10 @@ PP(pp_leavesub)
     }
     PUTBACK;
 
-    POPBLOCK(cx,newpm);
-    cxstack_ix++; /* temporarily protect top context */
     POPSUB(cx);	/* Stack values are safe: release CV and @_ ... */
-    cxstack_ix--;
+    POPBLOCK(cx,newpm);
     PL_curpm = newpm;	/* ... and pop $1 et al */
+    cxstack_ix--;
 
     return cx->blk_sub.retop;
 }
diff --git a/pp_sort.c b/pp_sort.c
index 1de1ca94d3..3bd9f2aabf 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1706,18 +1706,22 @@ PP(pp_sort)
 		    (is_xsub ? S_sortcv_xsub : hasargs ? S_sortcv_stacked : S_sortcv),
 		    sort_flags);
 
+            /* Reset cx, in case the context stack has been reallocated. */
+            cx = &cxstack[cxstack_ix];
+
+	    PL_stack_sp = PL_stack_base + cx->blk_oldsp;
+
 	    if (!(flags & OPf_SPECIAL)) {
-		/* Reset cx, in case the context stack has been
-		   reallocated. */
-		cx = &cxstack[cxstack_ix];
-		POPSUB(cx);
+                assert(CxTYPE(cx) == CXt_SUB);
+                POPSUB(cx);
 	    }
             else
+                assert(CxTYPE(cx) == CXt_NULL);
                 /* mimic POPSUB */
                 PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
 
 	    POPBLOCK(cx,PL_curpm);
-	    PL_stack_sp = PL_stack_base + cx->blk_oldsp;
+            cxstack_ix--;
 	    POPSTACK;
 	    CATCH_SET(oldcatch);
 	}
diff --git a/pp_sys.c b/pp_sys.c
index d54eb3859b..50c7433787 100644
--- a/pp_sys.c
+++ b/pp_sys.c
@@ -1520,10 +1520,13 @@ PP(pp_leavewrite)
     }
 
   forget_top:
+    cx = &cxstack[cxstack_ix];
+    assert(CxTYPE(cx) == CXt_FORMAT);
+    SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
+    POPFORMAT(cx);
     POPBLOCK(cx,PL_curpm);
     retop = cx->blk_sub.retop;
-    POPFORMAT(cx);
-    SP = PL_stack_base + cx->blk_oldsp; /* ignore retval of formline */
+    cxstack_ix--;
 
     if (is_return)
         /* XXX the semantics of doing 'return' in a format aren't documented.
diff --git a/regcomp.h b/regcomp.h
index b9c0613946..44c2c1c8de 100644
--- a/regcomp.h
+++ b/regcomp.h
@@ -1055,7 +1055,7 @@ re.pm, especially to the documentation.
 /* get_sv() can return NULL during global destruction. */
 #define GET_RE_DEBUG_FLAGS DEBUG_r({ \
         SV * re_debug_flags_sv = NULL; \
-        re_debug_flags_sv = get_sv(RE_DEBUG_FLAGS, 1); \
+        re_debug_flags_sv = PL_curcop ? get_sv(RE_DEBUG_FLAGS, 1) : NULL; \
         if (re_debug_flags_sv) { \
             if (!SvIOK(re_debug_flags_sv)) \
                 sv_setuv(re_debug_flags_sv, RE_DEBUG_COMPILE_DUMP | RE_DEBUG_EXECUTE_MASK ); \