Re: eliminate discreet arenaroots

[p5sagit/p5-mst-13.2.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index 3dda7cc..7580bf3 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1322,24 +1322,24 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 static I32
 cmpindir(pTHX_ gptr a, gptr b)
 {
-    I32 sense;
     gptr * const ap = (gptr *)a;
     gptr * const bp = (gptr *)b;
+    const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
 
-    if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)) == 0)
-        sense = (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
-    return sense;
+    if (sense)
+       return sense;
+    return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
 }
 
 static I32
 cmpindir_desc(pTHX_ gptr a, gptr b)
 {
-    I32 sense;
     gptr * const ap = (gptr *)a;
     gptr * const bp = (gptr *)b;
+    const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
 
     /* Reverse the default */
-    if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)))
+    if (sense)
        return -sense;
     /* But don't reverse the stability test.  */
     return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
@@ -1491,7 +1491,7 @@ PP(pp_sort)
     GV *gv;
     CV *cv = 0;
     I32 gimme = GIMME;
-    OP* nextop = PL_op->op_next;
+    OP* const nextop = PL_op->op_next;
     I32 overloading = 0;
     bool hasargs = FALSE;
     I32 is_xsub = 0;
@@ -1504,6 +1504,7 @@ PP(pp_sort)
 
     if (gimme != G_ARRAY) {
        SP = MARK;
+       EXTEND(SP,1);
        RETPUSHUNDEF;
     }
 
@@ -1542,14 +1543,8 @@ PP(pp_sort)
 
            if (is_xsub)
                PL_sortcop = (OP*)cv;
-           else {
+           else
                PL_sortcop = CvSTART(cv);
-               SAVEVPTR(CvROOT(cv)->op_ppaddr);
-               CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
-
-               SAVECOMPPAD();
-               PAD_SET_CUR_NOSAVE(CvPADLIST(cv), 1);
-            }
        }
     }
     else {
@@ -1574,6 +1569,10 @@ PP(pp_sort)
            }
        }
        else {
+           if (SvREADONLY(av))
+               Perl_croak(aTHX_ PL_no_modify);
+           else
+               SvREADONLY_on(av);
            p1 = p2 = AvARRAY(av);
            sorting_av = 1;
        }
@@ -1645,13 +1644,12 @@ PP(pp_sort)
            CATCH_SET(TRUE);
            PUSHSTACKi(PERLSI_SORT);
            if (!hasargs && !is_xsub) {
-               if (PL_sortstash != stash || !PL_firstgv || !PL_secondgv) {
-                   SAVESPTR(PL_firstgv);
-                   SAVESPTR(PL_secondgv);
-                   PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
-                   PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
-                   PL_sortstash = stash;
-               }
+               SAVESPTR(PL_firstgv);
+               SAVESPTR(PL_secondgv);
+               SAVESPTR(PL_sortstash);
+               PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV);
+               PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
+               PL_sortstash = stash;
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }
@@ -1661,23 +1659,39 @@ PP(pp_sort)
                cx->cx_type = CXt_SUB;
                cx->blk_gimme = G_SCALAR;
                PUSHSUB(cx);
-           }
-           PL_sortcxix = cxstack_ix;
+               if (!is_xsub) {
+                   AV* const padlist = CvPADLIST(cv);
 
-           if (hasargs && !is_xsub) {
-               /* This is mostly copied from pp_entersub */
-               AV *av = (AV*)PAD_SVl(0);
+                   if (++CvDEPTH(cv) >= 2) {
+                       PERL_STACK_OVERFLOW_CHECK();
+                       pad_push(padlist, CvDEPTH(cv));
+                   }
+                   SAVECOMPPAD();
+                   PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
+
+                   if (hasargs) {
+                       /* This is mostly copied from pp_entersub */
+                       AV *av = (AV*)PAD_SVl(0);
+
+                       cx->blk_sub.savearray = GvAV(PL_defgv);
+                       GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
+                       CX_CURPAD_SAVE(cx->blk_sub);
+                       cx->blk_sub.argarray = av;
+                   }
 
-               cx->blk_sub.savearray = GvAV(PL_defgv);
-               GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-               CX_CURPAD_SAVE(cx->blk_sub);
-               cx->blk_sub.argarray = av;
+               }
            }
+           cx->cx_type |= CXp_MULTICALL;
            
            start = p1 - max;
            sortsvp(aTHX_ start, max,
                    is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
 
+           if (!(flags & OPf_SPECIAL)) {
+               LEAVESUB(cv);
+               if (!is_xsub)
+                   CvDEPTH(cv)--;
+           }
            POPBLOCK(cx,PL_curpm);
            PL_stack_sp = newsp;
            POPSTACK;
@@ -1700,13 +1714,15 @@ PP(pp_sort)
        if (priv & OPpSORT_REVERSE) {
            SV **q = start+max-1;
            while (start < q) {
-               SV *tmp = *start;
+               SV * const tmp = *start;
                *start++ = *q;
                *q-- = tmp;
            }
        }
     }
-    if (av && !sorting_av) {
+    if (sorting_av)
+       SvREADONLY_off(av);
+    else if (av && !sorting_av) {
        /* simulate pp_aassign of tied AV */
        SV** const base = ORIGMARK+1;
        for (i=0; i < max; i++) {