X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/1ed44841e79d19d36361c250aecabc75154c999c..8aef2117c820d82091fcbab49e8ae3bc5312b954:/pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index f75ecd9..bfd7fa2 100644
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -555,7 +555,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 	    }
 	}
     }
-done:
+  done:
     if (aux != small) Safefree(aux);	/* free iff allocated */
     if (flags) {
 	 PL_sort_RealCmp = savecmp;	/* Restore current comparison routine, if any */
@@ -894,7 +894,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
             elements in the middle of the partition, those are the ones we
             pick here (conveniently pointed at by u_right, pc_left, and
             u_left). The values of the left, center, and right elements
-            are refered to as l c and r in the following comments.
+            are referred to as l c and r in the following comments.
          */
 
 #ifdef QSORT_ORDER_GUESS
@@ -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
@@ -1476,7 +1476,7 @@ PP(pp_sort)
     AV* av = NULL;
     GV *gv;
     CV *cv = NULL;
-    I32 gimme = GIMME;
+    I32 gimme = GIMME_V;
     OP* const nextop = PL_op->op_next;
     I32 overloading = 0;
     bool hasargs = FALSE;
@@ -1507,7 +1507,7 @@ PP(pp_sort)
     SAVEVPTR(PL_sortcop);
     if (flags & OPf_STACKED) {
 	if (flags & OPf_SPECIAL) {
-	    OP *nullop = OP_SIBLING(cLISTOP->op_first);	/* pass pushmark */
+            OP *nullop = OpSIBLING(cLISTOP->op_first);  /* pass pushmark */
             assert(nullop->op_type == OP_NULL);
 	    PL_sortcop = nullop->op_next;
 	}
@@ -1604,7 +1604,6 @@ PP(pp_sort)
     for (i=max; i > 0 ; i--) {
 	if ((*p1 = *p2++)) {			/* Weed out nulls. */
 	    if (copytmps && SvPADTMP(*p1)) {
-                assert(!IS_PADGV(*p1));
 		*p1 = sv_mortalcopy(*p1);
             }
 	    SvTEMP_off(*p1);
@@ -1643,8 +1642,8 @@ PP(pp_sort)
 	    PERL_CONTEXT *cx;
 	    SV** newsp;
 	    const bool oldcatch = CATCH_GET;
+            I32 old_savestack_ix = PL_savestack_ix;
 
-	    SAVETMPS;
 	    SAVEOP();
 
 	    CATCH_SET(TRUE);
@@ -1658,19 +1657,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);
 		PUSHSUB(cx);
 		if (!is_xsub) {
 		    PADLIST * const padlist = CvPADLIST(cv);
@@ -1679,7 +1680,6 @@ PP(pp_sort)
 			PERL_STACK_OVERFLOW_CHECK();
 			pad_push(padlist, CvDEPTH(cv));
 		    }
-		    SAVECOMPPAD();
 		    PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
 
 		    if (hasargs) {
@@ -1688,12 +1688,18 @@ 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;
 		    }
 
 		}
 	    }
+            else {
+                /* mimic PUSHSUB. Note that we're cheating and using a
+                 * CXt_NULL block as a CXt_SUB block */
+                cx->cx_u.cx_blk.blku_old_tmpsfloor = PL_tmps_floor;
+                PL_tmps_floor = PL_tmps_ix;
+            }
+            cx->cx_u.cx_blk.blku_old_savestack_ix = old_savestack_ix;
+
 	    cx->cx_type |= CXp_MULTICALL;
 	    
 	    start = p1 - max;
@@ -1709,6 +1715,10 @@ PP(pp_sort)
 		POPSUB(cx, sv);
 		LEAVESUB(sv);
 	    }
+            else
+                /* mimic POPSUB */
+                PL_tmps_floor = cx->cx_u.cx_blk.blku_old_tmpsfloor;
+
 	    POPBLOCK(cx,PL_curpm);
 	    PL_stack_sp = newsp;
 	    POPSTACK;
@@ -1772,9 +1782,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;
@@ -1784,21 +1792,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;
     }
@@ -1815,9 +1814,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;
 
@@ -1846,15 +1843,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;
     }
@@ -1882,9 +1876,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;
     }
@@ -2016,11 +2012,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:
  */