This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
move blku_old_savestack_ix to base of cxt struct
[perl5.git] / pp_ctl.c
diff --git a/pp_ctl.c b/pp_ctl.c
index 5e9907c..a35e80c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -285,7 +285,7 @@ PP(pp_substcont)
            /* PL_tainted must be correctly set for this mg_set */
            SvSETMAGIC(TARG);
            TAINT_NOT;
-           LEAVE_SCOPE(cx->sb_oldsave);
+           CX_LEAVE_SCOPE(cx);
            POPSUBST(cx);
            PERL_ASYNC_CHECK();
            RETURNOP(pm->op_next);
@@ -1291,7 +1291,7 @@ S_dopoptolabel(pTHX_ const char *label, STRLEN len, U32 flags)
            /* diag_listed_as: Exiting subroutine via %s */
            Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
                           context_name[CxTYPE(cx)], OP_NAME(PL_op));
-           if (CxTYPE(cx) == CXt_NULL)
+           if (CxTYPE(cx) == CXt_NULL) /* sort BLOCK */
                return -1;
            break;
        case CXt_LOOP_LAZYIV:
@@ -1438,7 +1438,7 @@ S_dopoptoloop(pTHX_ I32 startingblock)
            /* diag_listed_as: Exiting subroutine via %s */
            Perl_ck_warner(aTHX_ packWARN(WARN_EXITING), "Exiting %s via %s",
                           context_name[CxTYPE(cx)], OP_NAME(PL_op));
-           if ((CxTYPE(cx)) == CXt_NULL)
+           if ((CxTYPE(cx)) == CXt_NULL) /* sort BLOCK */
                return -1;
            break;
        case CXt_LOOP_LAZYIV:
@@ -1515,29 +1515,38 @@ Perl_dounwind(pTHX_ I32 cxix)
            POPSUBST(cx);
            continue;  /* not break */
        case CXt_SUB:
+            CX_LEAVE_SCOPE(cx);
            POPSUB(cx);
            break;
        case CXt_EVAL:
+            CX_LEAVE_SCOPE(cx);
            POPEVAL(cx);
            break;
        case CXt_BLOCK:
+            CX_LEAVE_SCOPE(cx);
             POPBASICBLK(cx);
            break;
        case CXt_LOOP_LAZYIV:
        case CXt_LOOP_LAZYSV:
        case CXt_LOOP_FOR:
        case CXt_LOOP_PLAIN:
+            CX_LEAVE_SCOPE(cx);
            POPLOOP(cx);
            break;
        case CXt_WHEN:
+            CX_LEAVE_SCOPE(cx);
            POPWHEN(cx);
            break;
        case CXt_GIVEN:
+            CX_LEAVE_SCOPE(cx);
            POPGIVEN(cx);
            break;
        case CXt_NULL:
+            /* there isn't a POPNULL ! */
+            CX_LEAVE_SCOPE(cx);
            break;
        case CXt_FORMAT:
+            CX_LEAVE_SCOPE(cx);
            POPFORMAT(cx);
            break;
        }
@@ -1656,8 +1665,9 @@ Perl_die_unwind(pTHX_ SV *msv)
                my_exit(1);
            }
 
+            CX_LEAVE_SCOPE(cx);
            POPEVAL(cx);
-           POPBLOCK(cx,PL_curpm);
+           POPBLOCK(cx);
             cxstack_ix--;
            namesv = cx->blk_eval.old_namesv;
 #ifdef DEBUGGING
@@ -1986,7 +1996,7 @@ PP(pp_dbstate)
            PUSHBLOCK(cx, CXt_SUB, SP);
            PUSHSUB_DB(cx);
            cx->blk_sub.retop = PL_op->op_next;
-            cx->cx_u.cx_blk.blku_old_savestack_ix = PL_savestack_ix;
+            cx->cx_old_savestack_ix = PL_savestack_ix;
 
             SAVEI32(PL_debug);
             PL_debug = 0;
@@ -2074,7 +2084,6 @@ PP(pp_leave)
 {
     PERL_CONTEXT *cx;
     SV **newsp;
-    PMOP *newpm;
     I32 gimme;
 
     cx = &cxstack[cxstack_ix];
@@ -2092,9 +2101,9 @@ PP(pp_leave)
         leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP,
                                PL_op->op_private & OPpLVALUE);
 
+    CX_LEAVE_SCOPE(cx);
     POPBASICBLK(cx);
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;  /* Don't pop $1 et al till now */
+    POPBLOCK(cx);
     cxstack_ix--;
 
     return NORMAL;
@@ -2255,7 +2264,6 @@ PP(pp_leaveloop)
     PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
-    PMOP *newpm;
     SV **mark;
 
     cx = &cxstack[cxstack_ix];
@@ -2270,9 +2278,9 @@ PP(pp_leaveloop)
         leave_common(newsp, MARK, gimme, SVs_PADTMP|SVs_TEMP,
                               PL_op->op_private & OPpLVALUE);
 
+    CX_LEAVE_SCOPE(cx);
     POPLOOP(cx);       /* Stack values are safe: release loop vars ... */
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;  /* ... and pop $1 et al */
+    POPBLOCK(cx);
     cxstack_ix--;
 
     return NORMAL;
@@ -2292,7 +2300,6 @@ PP(pp_leavesublv)
     dSP;
     SV **newsp;
     SV **mark;
-    PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     bool ref;
@@ -2331,6 +2338,7 @@ PP(pp_leavesublv)
                what = "undef";
            }
           croak:
+            CX_LEAVE_SCOPE(cx);
            POPSUB(cx);
            cxstack_ix--;
            PL_curpm = cx->blk_oldpm;
@@ -2400,9 +2408,9 @@ PP(pp_leavesublv)
     }
     PUTBACK;
 
+    CX_LEAVE_SCOPE(cx);
     POPSUB(cx);        /* Stack values are safe: release CV and @_ ... */
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;  /* ... and pop $1 et al */
+    POPBLOCK(cx);
     cxstack_ix--;
 
     return cx->blk_sub.retop;
@@ -2418,10 +2426,19 @@ PP(pp_return)
     assert(cxstack_ix >= 0);
     if (cxix < cxstack_ix) {
         if (cxix < 0) {
-            if (!CxMULTICALL(cxstack))
+            if (!(       PL_curstackinfo->si_type == PERLSI_SORT
+                  || (   PL_curstackinfo->si_type == PERLSI_MULTICALL
+                      && (cxstack[0].cx_type & CXp_SUB_RE_FAKE))
+                 )
+            )
                 DIE(aTHX_ "Can't return outside a subroutine");
-            /* We must be in a sort block, which is a CXt_NULL not a
-             * CXt_SUB. Handle specially. */
+            /* We must be in:
+             *  a sort block, which is a CXt_NULL not a CXt_SUB;
+             *  or a /(?{...})/ block.
+             * Handle specially. */
+            assert(CxTYPE(&cxstack[0]) == CXt_NULL
+                    || (   CxTYPE(&cxstack[0]) == CXt_SUB
+                        && (cxstack[0].cx_type & CXp_SUB_RE_FAKE)));
             if (cxstack_ix > 0) {
                 /* See comment below about context popping. Since we know
                  * we're scalar and not lvalue, we can preserve the return
@@ -2551,7 +2568,6 @@ S_unwind_loop(pTHX_ const char * const opname)
 PP(pp_last)
 {
     PERL_CONTEXT *cx;
-    PMOP *newpm;
 
     S_unwind_loop(aTHX_ "last");
 
@@ -2568,9 +2584,9 @@ PP(pp_last)
     TAINT_NOT;
 
     /* Stack values are safe: */
+    CX_LEAVE_SCOPE(cx);
     POPLOOP(cx);       /* release loop vars ... */
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;  /* ... and pop $1 et al */
+    POPBLOCK(cx);
     cxstack_ix--;
 
     return cx->blk_loop.my_op->op_lastop->op_next;
@@ -2750,8 +2766,6 @@ PP(pp_goto)
            TOPBLOCK(cx);
            SPAGAIN;
 
-            /* partial unrolled POPSUB(): */
-
             /* protect @_ during save stack unwind. */
             if (arg)
                 SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
@@ -2759,6 +2773,8 @@ PP(pp_goto)
            assert(PL_scopestack_ix == cx->blk_oldscopesp);
             CX_LEAVE_SCOPE(cx);
 
+            /* partial unrolled POPSUB(): */
+
            if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
                AV* av = MUTABLE_AV(PAD_SVl(0));
                 assert(AvARRAY(MUTABLE_AV(
@@ -3431,8 +3447,9 @@ S_doeval(pTHX_ int gimme, CV* outside, U32 seq, HV *hh)
            }
            SP = PL_stack_base + POPMARK;       /* pop original mark */
             cx = &cxstack[cxstack_ix];
+            CX_LEAVE_SCOPE(cx);
            POPEVAL(cx);
-           POPBLOCK(cx,PL_curpm);
+           POPBLOCK(cx);
             cxstack_ix--;
            namesv = cx->blk_eval.old_namesv;
        }
@@ -4085,7 +4102,7 @@ PP(pp_require)
     /* switch to eval mode */
     PUSHBLOCK(cx, CXt_EVAL, SP);
     PUSHEVAL(cx, name);
-    cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
+    cx->cx_old_savestack_ix = old_savestack_ix;
     cx->blk_eval.retop = PL_op->op_next;
 
     SAVECOPLINE(&PL_compiling);
@@ -4201,7 +4218,7 @@ PP(pp_entereval)
 
     PUSHBLOCK(cx, (CXt_EVAL|CXp_REAL), SP);
     PUSHEVAL(cx, 0);
-    cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
+    cx->cx_old_savestack_ix = old_savestack_ix;
     cx->blk_eval.retop = PL_op->op_next;
 
     /* prepare to compile string */
@@ -4249,7 +4266,6 @@ PP(pp_leaveeval)
 {
     dSP;
     SV **newsp;
-    PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     OP *retop;
@@ -4278,9 +4294,9 @@ PP(pp_leaveeval)
      * to get the current hints. So restore it early.
      */
     PL_curcop = cx->blk_oldcop;
+    CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;  /* Don't pop $1 et al till now */
+    POPBLOCK(cx);
     cxstack_ix--;
     namesv = cx->blk_eval.old_namesv;
     retop = cx->blk_eval.retop;
@@ -4317,14 +4333,13 @@ PP(pp_leaveeval)
 void
 Perl_delete_eval_scope(pTHX)
 {
-    PMOP *newpm;
     PERL_CONTEXT *cx;
     I32 optype;
        
     cx = &cxstack[cxstack_ix];
+    CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;
+    POPBLOCK(cx);
     cxstack_ix--;
     PERL_UNUSED_VAR(optype);
 }
@@ -4339,7 +4354,7 @@ Perl_create_eval_scope(pTHX_ U32 flags)
        
     PUSHBLOCK(cx, (CXt_EVAL|CXp_TRYBLOCK), PL_stack_sp);
     PUSHEVAL(cx, 0);
-    cx->cx_u.cx_blk.blku_old_savestack_ix = PL_savestack_ix;
+    cx->cx_old_savestack_ix = PL_savestack_ix;
 
     PL_in_eval = EVAL_INEVAL;
     if (flags & G_KEEPERR)
@@ -4362,7 +4377,6 @@ PP(pp_entertry)
 PP(pp_leavetry)
 {
     SV **newsp;
-    PMOP *newpm;
     I32 gimme;
     PERL_CONTEXT *cx;
     I32 optype;
@@ -4379,14 +4393,13 @@ PP(pp_leavetry)
         PL_stack_sp = newsp;
     else
         leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+    CX_LEAVE_SCOPE(cx);
     POPEVAL(cx);
-    POPBLOCK(cx,newpm);
+    POPBLOCK(cx);
     cxstack_ix--;
     retop = cx->blk_eval.retop;
     PERL_UNUSED_VAR(optype);
 
-    PL_curpm = newpm;  /* Don't pop $1 et al till now */
-
     CLEAR_ERRSV();
     return retop;
 }
@@ -4413,7 +4426,6 @@ PP(pp_leavegiven)
     PERL_CONTEXT *cx;
     I32 gimme;
     SV **newsp;
-    PMOP *newpm;
     PERL_UNUSED_CONTEXT;
 
     cx = &cxstack[cxstack_ix];
@@ -4425,9 +4437,10 @@ PP(pp_leavegiven)
         PL_stack_sp = newsp;
     else
         leave_common(newsp, newsp, gimme, SVs_PADTMP|SVs_TEMP, FALSE);
+
+    CX_LEAVE_SCOPE(cx);
     POPGIVEN(cx);
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;  /* Don't pop $1 et al till now */
+    POPBLOCK(cx);
     cxstack_ix--;
 
     return NORMAL;
@@ -5034,8 +5047,6 @@ PP(pp_continue)
 {
     I32 cxix;
     PERL_CONTEXT *cx;
-    PMOP *newpm;
-
     
     cxix = dopoptowhen(cxstack_ix); 
     if (cxix < 0)   
@@ -5047,9 +5058,9 @@ PP(pp_continue)
     cx = &cxstack[cxstack_ix];
     assert(CxTYPE(cx) == CXt_WHEN);
     PL_stack_sp = PL_stack_base + cx->blk_oldsp;
+    CX_LEAVE_SCOPE(cx);
     POPWHEN(cx);
-    POPBLOCK(cx,newpm);
-    PL_curpm = newpm;   /* pop $1 et al */
+    POPBLOCK(cx);
     cxstack_ix--;
 
     return cx->blk_givwhen.leave_op->op_next;
Unnamed repository; edit this file 'description' to name the repository.