Eliminate ENTER/LEAVE from sub calls

Every sub call is wrapped in an ENTER/LEAVE pair, which uses the next
free slot on the scope stack to save and then restore the old value of
PL_savestack_ix. Instead, store the old value in a new field in the
context structure, old_savestack_ix. This is quicker and simpler.

Not that we keep the ENTER/LEAVE for XS sub calls, as they don't push a
context frame, and so have nowhere else to remember PL_savestack_ix.

As a side-effect, this commit fixes a TODO test in t/op/sub.t,
which was related to dying while popping a context, then re-popping that
context. For the second pop, the scopestack has since been overwritten
and so too much was getting popped from the savestack. Since we no longer
use the scopestack, it's no longer an issue.

diff --git a/cop.h b/cop.h
index 3a643c3..8bc6ac1 100644 (file)
--- a/cop.h
+++ b/cop.h
@@ -555,6 +555,7 @@ struct block_sub {
     /* Above here is the same for sub and format.  */
     AV *       savearray;
     I32                olddepth;
+    I32         old_savestack_ix; /* saved PL_savestack_ix (also CXt_NULL) */
     PAD                *prevcomppad; /* the caller's PL_comppad */
     SSize_t     old_tmpsfloor; /* also used in CXt_NULL sort block */
 };
@@ -647,6 +648,7 @@ struct block_format {
 #define POPSUB(cx,sv)                                                  \
     STMT_START {                                                       \
        const I32 olddepth = cx->blk_sub.olddepth;                      \
+       LEAVE_SCOPE(cx->blk_sub.old_savestack_ix);                      \
         if (!(cx->blk_u16 & CxPOPSUB_DONE)) {                           \
         cx->blk_u16 |= CxPOPSUB_DONE;                                   \
        RETURN_PROBE(CvNAMED(cx->blk_sub.cv)                            \
@@ -671,7 +673,6 @@ struct block_format {
        }                                                               \
         }                                                               \
        sv = MUTABLE_SV(cx->blk_sub.cv);                                \
-       LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);               \
         PL_tmps_floor = cx->blk_sub.old_tmpsfloor;                      \
         PL_comppad = cx->blk_sub.prevcomppad;                           \
         PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;    \
@@ -1225,13 +1226,13 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
        CV * const _nOnclAshIngNamE_ = the_cv;                          \
        CV * const cv = _nOnclAshIngNamE_;                              \
        PADLIST * const padlist = CvPADLIST(cv);                        \
-       ENTER;                                                          \
        multicall_oldcatch = CATCH_GET;                                 \
-       SAVEVPTR(PL_op);                                                \
        CATCH_SET(TRUE);                                                \
        PUSHSTACKi(PERLSI_MULTICALL);                                   \
        PUSHBLOCK(cx, (CXt_SUB|CXp_MULTICALL|flags), PL_stack_sp);      \
        PUSHSUB(cx);                                                    \
+        cx->blk_sub.old_savestack_ix = PL_savestack_ix;                  \
+       SAVEVPTR(PL_op);                                                \
         if (!(flags & CXp_SUB_RE_FAKE))                                 \
             CvDEPTH(cv)++;                                             \
        if (CvDEPTH(cv) >= 2) {                                         \
@@ -1256,12 +1257,11 @@ See L<perlcall/LIGHTWEIGHT CALLBACKS>.
         LEAVESUB(multicall_cv);                                        \
        POPBLOCK(cx,PL_curpm);                                          \
         /* includes partial unrolled POPSUB(): */                       \
-       LEAVE_SCOPE(PL_scopestack[cx->blk_oldscopesp-1]);               \
+       LEAVE_SCOPE(cx->blk_sub.old_savestack_ix);                      \
         PL_comppad = cx->blk_sub.prevcomppad;                           \
         PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;    \
        POPSTACK;                                                       \
        CATCH_SET(multicall_oldcatch);                                  \
-       LEAVE;                                                          \
        SPAGAIN;                                                        \
     } STMT_END
 

diff --git a/pp_ctl.c b/pp_ctl.c
index e9a6c09..deeb583 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1942,7 +1942,6 @@ PP(pp_dbstate)
        dSP;
        PERL_CONTEXT *cx;
        const I32 gimme = G_ARRAY;
-       U8 hasargs;
        GV * const gv = PL_DBgv;
        CV * cv = NULL;
 
@@ -1956,15 +1955,11 @@ PP(pp_dbstate)
            /* don't do recursive DB::DB call */
            return NORMAL;
 
-       ENTER;
-
-       SAVEI32(PL_debug);
-       SAVESTACK_POS();
-       PL_debug = 0;
-       hasargs = 0;
-       SPAGAIN;
-
        if (CvISXSUB(cv)) {
+            ENTER;
+            SAVEI32(PL_debug);
+            PL_debug = 0;
+            SAVESTACK_POS();
             SAVETMPS;
            PUSHMARK(SP);
            (void)(*CvXSUB(cv))(aTHX_ cv);
@@ -1973,9 +1968,15 @@ PP(pp_dbstate)
            return NORMAL;
        }
        else {
+            U8 hasargs = 0;
            PUSHBLOCK(cx, CXt_SUB, SP);
            PUSHSUB_DB(cx);
            cx->blk_sub.retop = PL_op->op_next;
+            cx->blk_sub.old_savestack_ix = PL_savestack_ix;
+
+            SAVEI32(PL_debug);
+            PL_debug = 0;
+            SAVESTACK_POS();
            CvDEPTH(cv)++;
            if (CvDEPTH(cv) >= 2) {
                PERL_STACK_OVERFLOW_CHECK();
@@ -2314,7 +2315,6 @@ PP(pp_leavesublv)
                what = "undef";
            }
           croak:
-           LEAVE;
            POPSUB(cx,sv);
            cxstack_ix--;
            PL_curpm = newpm;
@@ -2385,7 +2385,6 @@ PP(pp_leavesublv)
     }
     PUTBACK;
 
-    LEAVE;
     POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
     cxstack_ix--;
     PL_curpm = newpm;  /* ... and pop $1 et al */
@@ -2675,7 +2674,6 @@ PP(pp_goto)
            PERL_CONTEXT *cx;
            CV *cv = MUTABLE_CV(SvRV(sv));
            AV *arg = GvAV(PL_defgv);
-           I32 oldsave;
 
            while (!CvROOT(cv) && !CvXSUB(cv)) {
                const GV * const gv = CvGV(cv);
@@ -2726,6 +2724,13 @@ PP(pp_goto)
 
             /* partial unrolled POPSUB(): */
 
+            /* protect @_ during save stack unwind. */
+            if (arg)
+                SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
+
+           assert(PL_scopestack_ix == cx->blk_oldscopesp);
+            LEAVE_SCOPE(cx->blk_sub.old_savestack_ix);
+
            if (CxTYPE(cx) == CXt_SUB && CxHASARGS(cx)) {
                AV* av = MUTABLE_AV(PAD_SVl(0));
                 assert(AvARRAY(MUTABLE_AV(
@@ -2743,14 +2748,6 @@ PP(pp_goto)
                else CLEAR_ARGARRAY(av);
            }
 
-            /* protect @_ during save stack unwind. */
-            if (arg)
-                SvREFCNT_inc_NN(sv_2mortal(MUTABLE_SV(arg)));
-
-           assert(PL_scopestack_ix == cx->blk_oldscopesp);
-           oldsave = PL_scopestack[cx->blk_oldscopesp - 1];
-           LEAVE_SCOPE(oldsave);
-
             /* don't restore PL_comppad here. It won't be needed if the
              * sub we're going to is non-XS, but restoring it early then
              * croaking (e.g. the "Goto undefined subroutine" below)
@@ -2786,6 +2783,7 @@ PP(pp_goto)
                 PERL_UNUSED_VAR(newsp);
                 PERL_UNUSED_VAR(gimme);
 
+                ENTER;
                 SAVETMPS;
                 SAVEFREESV(cv); /* later, undo the 'avoid premature free' hack */
 
@@ -2819,8 +2817,13 @@ PP(pp_goto)
                retop = cx->blk_sub.retop;
                 PL_comppad = cx->blk_sub.prevcomppad;
                 PL_curpad = LIKELY(PL_comppad) ? AvARRAY(PL_comppad) : NULL;
-               /* XS subs don't have a CxSUB, so pop it */
-               POPBLOCK(cx, PL_curpm);
+
+               /* XS subs don't have a CXt_SUB, so pop it;
+                 * this is a POPBLOCK(), less all the stuff we already did
+                 * for TOPBLOCK() earlier */
+                PL_curcop = cx->blk_oldcop;
+               cxstack_ix--;
+
                /* Push a mark for the start of arglist */
                PUSHMARK(mark);
                PUTBACK;

diff --git a/pp_hot.c b/pp_hot.c
index 6d7b5e2..5a8fc34 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -3327,7 +3327,6 @@ PP(pp_leavesub)
     }
     PUTBACK;
 
-    LEAVE;
     POPSUB(cx,sv);     /* Stack values are safe: release CV and @_ ... */
     cxstack_ix--;
     PL_curpm = newpm;  /* ... and pop $1 et al */
@@ -3367,6 +3366,7 @@ PP(pp_entersub)
     PERL_CONTEXT *cx;
     I32 gimme;
     const bool hasargs = (PL_op->op_flags & OPf_STACKED) != 0;
+    I32 old_savestack_ix;
 
     if (UNLIKELY(!sv))
        DIE(aTHX_ "Not a CODE reference");
@@ -3380,7 +3380,7 @@ PP(pp_entersub)
                 cv = sv_2cv(sv, &stash, &gv, 0);
             }
             if (!cv) {
-                ENTER;
+                old_savestack_ix = PL_savestack_ix;
                 goto try_autoload;
             }
             break;
@@ -3429,7 +3429,13 @@ PP(pp_entersub)
         }
     }
 
-    ENTER;
+    /* At this point we want to save PL_savestack_ix, either by doing a
+     * PUSHSUB, or for XS, doing an ENTER. But we don't yet know the final
+     * CV we will be using (so we don't know whether its XS, so we can't
+     * PUSHSUB or ENTER yet), and determining cv may itself push stuff on
+     * the save stack. So remember where we are currently on the save
+     * stack, and later update the CX or scopestack entry accordingly. */
+    old_savestack_ix = PL_savestack_ix;
 
     /* these two fields are in a union. If they ever become separate,
      * we have to test for both of them being null below */
@@ -3513,8 +3519,9 @@ PP(pp_entersub)
 
        PUSHBLOCK(cx, CXt_SUB, MARK);
        PUSHSUB(cx);
-
        cx->blk_sub.retop = PL_op->op_next;
+        cx->blk_sub.old_savestack_ix = old_savestack_ix;
+
        if (UNLIKELY((depth = ++CvDEPTH(cv)) >= 2)) {
            PERL_STACK_OVERFLOW_CHECK();
            pad_push(padlist, depth);
@@ -3563,6 +3570,10 @@ PP(pp_entersub)
     else {
        SSize_t markix = TOPMARK;
 
+        ENTER;
+        /* pretend we did the ENTER earlier */
+       PL_scopestack[PL_scopestack_ix - 1] = old_savestack_ix;
+
        SAVETMPS;
        PUTBACK;
 

diff --git a/pp_sort.c b/pp_sort.c
index f4664f9..bb0e761 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1642,6 +1642,7 @@ PP(pp_sort)
            PERL_CONTEXT *cx;
            SV** newsp;
            const bool oldcatch = CATCH_GET;
+            I32 old_savestack_ix = PL_savestack_ix;
 
            SAVEOP();
 
@@ -1697,6 +1698,7 @@ PP(pp_sort)
                 cx->blk_sub.old_tmpsfloor = PL_tmps_floor;
                 PL_tmps_floor = PL_tmps_ix;
             }
+            cx->blk_sub.old_savestack_ix = old_savestack_ix;
 
            cx->cx_type |= CXp_MULTICALL;
            

diff --git a/t/op/sub.t b/t/op/sub.t
index eaae3de..367f325 100644 (file)
--- a/t/op/sub.t
+++ b/t/op/sub.t
@@ -326,7 +326,6 @@ pass("RT #126845: stub with prototype, then definition with attribute");
     }
 
     f();
-    local $::TODO = "sub unwinding not safe yet";
     ::is($y, 7, "tie_exception");
 }