Assimilate Digest 1.05

[perl5.git] / pp_sort.c

diff --git a/pp_sort.c b/pp_sort.c
index 5d6ce86..8fe6bcd 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -1,6 +1,7 @@
 /*    pp_sort.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
+ *    2000, 2001, 2002, 2003, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -34,10 +35,9 @@ static I32 amagic_cmp_locale(pTHX_ SV *a, SV *b);
 #define sv_cmp_static Perl_sv_cmp
 #define sv_cmp_locale_static Perl_sv_cmp_locale
 
-#define SORTHINTS(hintsvp) \
-     ((PL_hintgv &&    \
-      (hintsvp = hv_fetch(GvHV(PL_hintgv), "SORT", 4, FALSE))) ? \
-         (I32)SvIV(*hintsvp) : 0)
+#define SORTHINTS(hintsv) \
+    (((hintsv) = GvSV(gv_fetchpv("sort::hints", GV_ADDMULTI, SVt_IV))), \
+    (SvIOK(hintsv) ? ((I32)SvIV(hintsv)) : 0))
 
 #ifndef SMALLSORT
 #define        SMALLSORT (200)
@@ -1287,7 +1287,6 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
  * dictated by the indirect array.
  */
 
-static SVCOMPARE_t RealCmp;
 
 static I32
 cmpindir(pTHX_ gptr a, gptr b)
@@ -1296,7 +1295,7 @@ cmpindir(pTHX_ gptr a, gptr b)
     gptr *ap = (gptr *)a;
     gptr *bp = (gptr *)b;
 
-    if ((sense = RealCmp(aTHX_ *ap, *bp)) == 0)
+    if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp)) == 0)
         sense = (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
     return sense;
 }
@@ -1304,9 +1303,9 @@ cmpindir(pTHX_ gptr a, gptr b)
 STATIC void
 S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
 {
-    SV **hintsvp;
+    SV *hintsv;
 
-    if (SORTHINTS(hintsvp) & HINT_SORT_STABLE) {
+    if (SORTHINTS(hintsv) & HINT_SORT_STABLE) {
         register gptr **pp, *q;
         register size_t n, j, i;
         gptr *small[SMALLSORT], **indir, tmp;
@@ -1320,8 +1319,8 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
         /* Copy pointers to original array elements into indirect array */
         for (n = nmemb, pp = indir, q = list1; n--; ) *pp++ = q++;
 
-        savecmp = RealCmp;     /* Save current comparison routine, if any */
-        RealCmp = cmp; /* Put comparison routine where cmpindir can find it */
+        savecmp = PL_sort_RealCmp;     /* Save current comparison routine, if any */
+        PL_sort_RealCmp = cmp; /* Put comparison routine where cmpindir can find it */
 
         /* sort, with indirection */
         S_qsortsvu(aTHX_ (gptr *)indir, nmemb, cmpindir);
@@ -1366,7 +1365,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
        /* free iff allocated */
         if (indir != small) { Safefree(indir); }
         /* restore prevailing comparison routine */
-        RealCmp = savecmp;
+        PL_sort_RealCmp = savecmp;
     } else {
         S_qsortsvu(aTHX_ list1, nmemb, cmp);
     }
@@ -1391,7 +1390,7 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
 {
     void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) =
         S_mergesortsv;
-    SV **hintsvp;
+    SV *hintsv;
     I32 hints;
 
     /*  Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used 
@@ -1399,7 +1398,7 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
        errors related to picking the correct sort() function, try recompiling 
        this file without optimiziation.  -- A.D.  4/2002.
     */
-    hints = SORTHINTS(hintsvp);
+    hints = SORTHINTS(hintsv);
     if (hints & HINT_SORT_QUICKSORT) {
        sortsvp = S_qsortsv;
     }
@@ -1457,8 +1456,8 @@ PP(pp_sort)
                else if (gv) {
                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, Nullch);
-                   DIE(aTHX_ "Undefined sort subroutine \"%s\" called",
-                       SvPVX(tmpstr));
+                   DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
+                       tmpstr);
                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");
@@ -1472,8 +1471,7 @@ PP(pp_sort)
                SAVEVPTR(CvROOT(cv)->op_ppaddr);
                CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
 
-               SAVEVPTR(PL_curpad);
-               PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
+               PAD_SET_CUR(CvPADLIST(cv), 1);
             }
        }
     }
@@ -1517,10 +1515,6 @@ PP(pp_sort)
                    PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV);
                    PL_sortstash = stash;
                }
-#ifdef USE_5005THREADS
-               sv_lock((SV *)PL_firstgv);
-               sv_lock((SV *)PL_secondgv);
-#endif
                SAVESPTR(GvSV(PL_firstgv));
                SAVESPTR(GvSV(PL_secondgv));
            }
@@ -1537,13 +1531,11 @@ PP(pp_sort)
 
            if (hasargs && !is_xsub) {
                /* This is mostly copied from pp_entersub */
-               AV *av = (AV*)PL_curpad[0];
+               AV *av = (AV*)PAD_SVl(0);
 
-#ifndef USE_5005THREADS
                cx->blk_sub.savearray = GvAV(PL_defgv);
                GvAV(PL_defgv) = (AV*)SvREFCNT_inc(av);
-#endif /* USE_5005THREADS */
-               cx->blk_sub.oldcurpad = PL_curpad;
+               CX_CURPAD_SAVE(cx->blk_sub);
                cx->blk_sub.argarray = av;
            }
            sortsv((myorigmark+1), max,
@@ -1615,11 +1607,7 @@ sortcv_stacked(pTHX_ SV *a, SV *b)
     I32 result;
     AV *av;
 
-#ifdef USE_5005THREADS
-    av = (AV*)PL_curpad[0];
-#else
     av = GvAV(PL_defgv);
-#endif
 
     if (AvMAX(av) < 1) {
        SV** ary = AvALLOC(av);