Get blocks.t working under miniperl

[perl5.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index b65e9eb..f75ecd9 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -53,9 +53,12 @@
  * The original code was written in conjunction with BSD Computer Software
  * Research Group at University of California, Berkeley.
  *
- * See also: "Optimistic Merge Sort" (SODA '92)
+ * See also: "Optimistic Sorting and Information Theoretic Complexity"
+ *           Peter McIlroy
+ *           SODA (Fourth Annual ACM-SIAM Symposium on Discrete Algorithms),
+ *           pp 467-474, Austin, Texas, 25-27 January 1993.
  *
- * The integration to Perl is by John P. Linderman <jpl@research.att.com>.
+ * The integration to Perl is by John P. Linderman <jpl.jpl@gmail.com>.
  *
  * The code can be distributed under the same terms as Perl itself.
  *
@@ -344,14 +347,12 @@ typedef struct {
 static I32
 cmp_desc(pTHX_ gptr const a, gptr const b)
 {
-    dVAR;
     return -PL_sort_RealCmp(aTHX_ a, b);
 }
 
 STATIC void
 S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 {
-    dVAR;
     IV i, run, offset;
     I32 sense, level;
     gptr *f1, *f2, *t, *b, *p;
@@ -1319,7 +1320,6 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 static I32
 cmpindir(pTHX_ gptr const a, gptr const b)
 {
-    dVAR;
     gptr * const ap = (gptr *)a;
     gptr * const bp = (gptr *)b;
     const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
@@ -1332,7 +1332,6 @@ cmpindir(pTHX_ gptr const a, gptr const b)
 static I32
 cmpindir_desc(pTHX_ gptr const a, gptr const b)
 {
-    dVAR;
     gptr * const ap = (gptr *)a;
     gptr * const bp = (gptr *)b;
     const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
@@ -1348,7 +1347,6 @@ cmpindir_desc(pTHX_ gptr const a, gptr const b)
 STATIC void
 S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 {
-    dVAR;
     if ((flags & SORTf_STABLE) != 0) {
         gptr **pp, *q;
         size_t n, j, i;
@@ -1430,11 +1428,11 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 
 =for apidoc sortsv
 
-Sort an array. Here is an example:
+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 sortsv_flags for a more
 flexible routine.
 
 =cut
@@ -1472,11 +1470,10 @@ Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 
 PP(pp_sort)
 {
-    dVAR; dSP; dMARK; dORIGMARK;
+    dSP; dMARK; dORIGMARK;
     SV **p1 = ORIGMARK+1, **p2;
     SSize_t max, i;
     AV* av = NULL;
-    HV *stash;
     GV *gv;
     CV *cv = NULL;
     I32 gimme = GIMME;
@@ -1510,14 +1507,13 @@ PP(pp_sort)
     SAVEVPTR(PL_sortcop);
     if (flags & OPf_STACKED) {
        if (flags & OPf_SPECIAL) {
-           OP *kid = cLISTOP->op_first->op_sibling;    /* pass pushmark */
-           kid = kUNOP->op_first;                      /* pass rv2gv */
-           kid = kUNOP->op_first;                      /* pass leave */
-           PL_sortcop = kid->op_next;
-           stash = CopSTASH(PL_curcop);
+           OP *nullop = OP_SIBLING(cLISTOP->op_first); /* pass pushmark */
+            assert(nullop->op_type == OP_NULL);
+           PL_sortcop = nullop->op_next;
        }
        else {
            GV *autogv = NULL;
+           HV *stash;
            cv = sv_2cv(*++MARK, &stash, &gv, GV_ADD);
          check_cv:
            if (cv && SvPOK(cv)) {
@@ -1565,7 +1561,6 @@ PP(pp_sort)
     }
     else {
        PL_sortcop = NULL;
-       stash = CopSTASH(PL_curcop);
     }
 
     /* optimiser converts "@a = sort @a" to "sort \@a";
@@ -1608,8 +1603,10 @@ PP(pp_sort)
     copytmps = !sorting_av && PL_sortcop;
     for (i=max; i > 0 ; i--) {
        if ((*p1 = *p2++)) {                    /* Weed out nulls. */
-           if (copytmps && SvPADTMP(*p1) && !IS_PADGV(*p1))
+           if (copytmps && SvPADTMP(*p1)) {
+                assert(!IS_PADGV(*p1));
                *p1 = sv_mortalcopy(*p1);
+            }
            SvTEMP_off(*p1);
            if (!PL_sortcop) {
                if (priv & OPpSORT_NUMERIC) {
@@ -1653,10 +1650,14 @@ PP(pp_sort)
            CATCH_SET(TRUE);
            PUSHSTACKi(PERLSI_SORT);
            if (!hasargs && !is_xsub) {
-               SAVESPTR(PL_firstgv);
-               SAVESPTR(PL_secondgv);
-               PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
-               PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);
+               SAVEGENERICSV(PL_firstgv);
+               SAVEGENERICSV(PL_secondgv);
+               PL_firstgv = MUTABLE_GV(SvREFCNT_inc(
+                   gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV)
+               ));
+               PL_secondgv = MUTABLE_GV(SvREFCNT_inc(
+                   gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV)
+               ));
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }
@@ -1721,11 +1722,15 @@ PP(pp_sort)
                        ? ( ( ( priv & OPpSORT_INTEGER) || all_SIVs)
                            ? ( overloading ? S_amagic_i_ncmp : S_sv_i_ncmp)
                            : ( overloading ? S_amagic_ncmp : S_sv_ncmp ) )
-                       : ( IN_LOCALE_RUNTIME
+                       : (
+#ifdef USE_LOCALE_COLLATE
+                           IN_LC_RUNTIME(LC_COLLATE)
                            ? ( overloading
                                ? (SVCOMPARE_t)S_amagic_cmp_locale
                                : (SVCOMPARE_t)sv_cmp_locale_static)
-                           : ( overloading ? (SVCOMPARE_t)S_amagic_cmp : (SVCOMPARE_t)sv_cmp_static)),
+                            :
+#endif
+                             ( overloading ? (SVCOMPARE_t)S_amagic_cmp : (SVCOMPARE_t)sv_cmp_static)),
                    sort_flags);
        }
        if ((priv & OPpSORT_REVERSE) != 0) {
@@ -1764,7 +1769,6 @@ PP(pp_sort)
 static I32
 S_sortcv(pTHX_ SV *const a, SV *const b)
 {
-    dVAR;
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
@@ -1806,7 +1810,6 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
 static I32
 S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 {
-    dVAR;
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     I32 result;
@@ -1863,7 +1866,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
 static I32
 S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
 {
-    dVAR; dSP;
+    dSP;
     const I32 oldsaveix = PL_savestack_ix;
     const I32 oldscopeix = PL_scopestack_ix;
     CV * const cv=MUTABLE_CV(PL_sortcop);
@@ -1931,7 +1934,6 @@ S_sv_i_ncmp(pTHX_ SV *const a, SV *const b)
 static I32
 S_amagic_ncmp(pTHX_ SV *const a, SV *const b)
 {
-    dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_NCMP;
@@ -1952,7 +1954,6 @@ S_amagic_ncmp(pTHX_ SV *const a, SV *const b)
 static I32
 S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b)
 {
-    dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
@@ -1973,7 +1974,6 @@ S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b)
 static I32
 S_amagic_cmp(pTHX_ SV *const str1, SV *const str2)
 {
-    dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_CMP;
@@ -1991,10 +1991,11 @@ S_amagic_cmp(pTHX_ SV *const str1, SV *const str2)
     return sv_cmp(str1, str2);
 }
 
+#ifdef USE_LOCALE_COLLATE
+
 static I32
 S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
 {
-    dVAR;
     SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;
@@ -2012,6 +2013,8 @@ S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
     return sv_cmp_locale(str1, str2);
 }
 
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd