move blku_old_savestack_ix to base of cxt struct

[perl5.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index 54132b4..8a4bb0f 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1432,7 +1432,7 @@ Sort an array.  Here is an example:
 
     sortsv(AvARRAY(av), av_top_index(av)+1, Perl_sv_cmp_locale);
 
-Currently this always uses mergesort.  See sortsv_flags for a more
+Currently this always uses mergesort.  See C<L</sortsv_flags>> for a more
 flexible routine.
 
 =cut
@@ -1640,10 +1640,9 @@ PP(pp_sort)
        SV **start;
        if (PL_sortcop) {
            PERL_CONTEXT *cx;
-           SV** newsp;
            const bool oldcatch = CATCH_GET;
+            I32 old_savestack_ix = PL_savestack_ix;
 
-           SAVETMPS;
            SAVEOP();
 
            CATCH_SET(TRUE);
@@ -1657,19 +1656,21 @@ PP(pp_sort)
                PL_secondgv = MUTABLE_GV(SvREFCNT_inc(
                    gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV)
                ));
+                /* make sure the GP isn't removed out from under us for
+                 * the SAVESPTR() */
+                save_gp(PL_firstgv, 0);
+                save_gp(PL_secondgv, 0);
+                /* we don't want modifications localized */
+                GvINTRO_off(PL_firstgv);
+                GvINTRO_off(PL_secondgv);
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }
 
+            gimme = G_SCALAR;
            PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
            if (!(flags & OPf_SPECIAL)) {
-               cx->cx_type = CXt_SUB;
-               cx->blk_gimme = G_SCALAR;
-               /* If our comparison routine is already active (CvDEPTH is
-                * is not 0),  then PUSHSUB does not increase the refcount,
-                * so we have to do it ourselves, because the LEAVESUB fur-
-                * ther down lowers it. */
-               if (CvDEPTH(cv)) SvREFCNT_inc_simple_void_NN(cv);
+               cx->cx_type = CXt_SUB|CXp_MULTICALL;
                PUSHSUB(cx);
                if (!is_xsub) {
                    PADLIST * const padlist = CvPADLIST(cv);
@@ -1678,7 +1679,6 @@ PP(pp_sort)
                        PERL_STACK_OVERFLOW_CHECK();
                        pad_push(padlist, CvDEPTH(cv));
                    }
-                   SAVECOMPPAD();
                    PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
 
                    if (hasargs) {
@@ -1687,29 +1687,33 @@ PP(pp_sort)
 
                        cx->blk_sub.savearray = GvAV(PL_defgv);
                        GvAV(PL_defgv) = MUTABLE_AV(SvREFCNT_inc_simple(av));
-                       CX_CURPAD_SAVE(cx->blk_sub);
-                       cx->blk_sub.argarray = av;
                    }
 
                }
            }
-           cx->cx_type |= CXp_MULTICALL;
-           
+            cx->cx_old_savestack_ix = old_savestack_ix;
+
            start = p1 - max;
            sortsvp(aTHX_ start, max,
                    (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;
+
+            CX_LEAVE_SCOPE(cx);
            if (!(flags & OPf_SPECIAL)) {
-               SV *sv;
-               /* Reset cx, in case the context stack has been
-                  reallocated. */
-               cx = &cxstack[cxstack_ix];
-               POPSUB(cx, sv);
-               LEAVESUB(sv);
+                assert(CxTYPE(cx) == CXt_SUB);
+                POPSUB(cx);
            }
-           POPBLOCK(cx,PL_curpm);
-           PL_stack_sp = newsp;
+            else
+                assert(CxTYPE(cx) == CXt_NULL);
+                /* there isn't a POPNULL ! */
+
+           POPBLOCK(cx);
+            cxstack_ix--;
            POPSTACK;
            CATCH_SET(oldcatch);
        }
@@ -1771,9 +1775,7 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
-    SV *resultsv;
     PMOP * const pm = PL_curpm;
-    OP * const sortop = PL_op;
     COP * const cop = PL_curcop;
  
     PERL_ARGS_ASSERT_SORTCV;
@@ -1783,21 +1785,12 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    PL_op = sortop;
     PL_curcop = cop;
-    if (PL_stack_sp != PL_stack_base + 1) {
-       assert(PL_stack_sp == PL_stack_base);
-       resultsv = &PL_sv_undef;
-    }
-    else resultsv = *PL_stack_sp;
-    if (SvNIOK_nog(resultsv)) result = SvIV(resultsv);
-    else {
-       ENTER;
-       SAVEVPTR(PL_curpad);
-       PL_curpad = 0;
-       result = SvIV(resultsv);
-       LEAVE;
-    }
+    /* entry zero of a stack is always PL_sv_undef, which
+     * simplifies converting a '()' return into undef in scalar context */
+    assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+    result = SvIV(*PL_stack_sp);
+
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
@@ -1814,9 +1807,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     I32 result;
     AV * const av = GvAV(PL_defgv);
     PMOP * const pm = PL_curpm;
-    OP * const sortop = PL_op;
     COP * const cop = PL_curcop;
-    SV **pad;
 
     PERL_ARGS_ASSERT_SORTCV_STACKED;
 
@@ -1845,15 +1836,12 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    PL_op = sortop;
     PL_curcop = cop;
-    pad = PL_curpad; PL_curpad = 0;
-    if (PL_stack_sp != PL_stack_base + 1) {
-       assert(PL_stack_sp == PL_stack_base);
-       result = SvIV(&PL_sv_undef);
-    }
-    else result = SvIV(*PL_stack_sp);
-    PL_curpad = pad;
+    /* entry zero of a stack is always PL_sv_undef, which
+     * simplifies converting a '()' return into undef in scalar context */
+    assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
+    result = SvIV(*PL_stack_sp);
+
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
@@ -1881,9 +1869,11 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
     *++SP = b;
     PUTBACK;
     (void)(*CvXSUB(cv))(aTHX_ cv);
-    if (PL_stack_sp != PL_stack_base + 1)
-       Perl_croak(aTHX_ "Sort subroutine didn't return single value");
+    /* entry zero of a stack is always PL_sv_undef, which
+     * simplifies converting a '()' return into undef in scalar context */
+    assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
     result = SvIV(*PL_stack_sp);
+
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
@@ -2015,11 +2005,5 @@ S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
 #endif
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */