This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Get blocks.t working under miniperl
[perl5.git] / pp_sort.c
index a75eab7..f75ecd9 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -9,8 +9,10 @@
  */
 
 /*
- *   ...they shuffled back towards the rear of the line. 'No, not at the
- *   rear!'  the slave-driver shouted. 'Three files up. And stay there...
+ *   ...they shuffled back towards the rear of the line.  'No, not at the
+ *   rear!' the slave-driver shouted.  'Three files up. And stay there...
+ *
+ *     [p.931 of _The Lord of the Rings_, VI/ii: "The Land of Shadow"]
  */
 
 /* This file contains pp ("push/pop") functions that
  * 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.
  *
@@ -103,7 +108,7 @@ typedef SV * gptr;          /* pointers in our lists */
 #define FROMTOUPTO(src, dst, lim) do *dst++ = *src++; while(src<lim)
 
 
-/* Runs are identified by a pointer in the auxilliary list.
+/* Runs are identified by a pointer in the auxiliary list.
 ** The pointer is at the start of the list,
 ** and it points to the start of the next list.
 ** NEXT is used as an lvalue, too.
@@ -183,8 +188,8 @@ static IV
 dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp)
 {
     I32 sense;
-    register gptr *b, *p, *q, *t, *p2;
-    register gptr *last, *r;
+    gptr *b, *p, *q, *t, *p2;
+    gptr *last, *r;
     IV runs = 0;
 
     b = list1;
@@ -204,7 +209,7 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp)
            if (r >= t) p = r = t;      /* too short to care about */
            else {
                while (((cmp(aTHX_ *(p-1), *p) > 0) == sense) &&
-                      ((p -= 2) > q));
+                      ((p -= 2) > q)) {}
                if (p <= q) {
                    /* b through r is a (long) run.
                    ** Extend it as far as possible.
@@ -342,17 +347,15 @@ 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;
-    register gptr *f1, *f2, *t, *b, *p;
+    gptr *f1, *f2, *t, *b, *p;
     int iwhich;
     gptr *aux;
     gptr *p1;
@@ -370,7 +373,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     }
 
     if (nmemb <= SMALLSORT) aux = small;       /* use stack for aux array */
-    else { Newx(aux,nmemb,gptr); }             /* allocate auxilliary array */
+    else { Newx(aux,nmemb,gptr); }             /* allocate auxiliary array */
     level = 0;
     stackp = stack;
     stackp->runs = dynprep(aTHX_ base, aux, nmemb, cmp);
@@ -390,7 +393,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
            list1 = which[iwhich];              /* area where runs are now */
            list2 = which[++iwhich];            /* area for merged runs */
            do {
-               register gptr *l1, *l2, *tp2;
+               gptr *l1, *l2, *tp2;
                offset = stackp->offset;
                f1 = p1 = list1 + offset;               /* start of first run */
                p = tp2 = list2 + offset;       /* where merged run will go */
@@ -420,7 +423,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
                    ** and -1 when equality should look high.
                    */
 
-                   register gptr *q;
+                   gptr *q;
                    if (cmp(aTHX_ *f1, *f2) <= 0) {
                        q = f2; b = f1; t = l1;
                        sense = -1;
@@ -547,7 +550,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
                t = NEXT(t);                    /* where second run will end */
                t = PINDEX(base, PNELEM(aux, t)); /* where it now ends */
                FROMTOUPTO(f1, f2, t);          /* copy both runs */
-               NEXT(b) = p;                    /* paralled pointer for 1st */
+               NEXT(b) = p;                    /* paralleled pointer for 1st */
                NEXT(p) = t;                    /* ... and for second */
            }
        }
@@ -761,7 +764,7 @@ doqsort_all_asserts(
 STATIC void /* the standard unstable (u) quicksort (qsort) */
 S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
 {
-   register SV * temp;
+   SV * temp;
    struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
    int next_stack_entry = 0;
    int part_left;
@@ -779,12 +782,12 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
       return;
    }
 
-   /* Innoculate large partitions against quadratic behavior */
+   /* Inoculate large partitions against quadratic behavior */
    if (num_elts > QSORT_PLAY_SAFE) {
-      register size_t n;
-      register SV ** const q = array;
+      size_t n;
+      SV ** const q = array;
       for (n = num_elts; n > 1; ) {
-         register const size_t j = (size_t)(n-- * Drand01());
+         const size_t j = (size_t)(n-- * Drand01());
          temp = q[j];
          q[j] = q[n];
          q[n] = temp;
@@ -1289,7 +1292,7 @@ S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
  * by the original comparison routine on the elements pointed to.
  * Because we don't move the elements of list1 around through
  * this phase, we can break ties on elements that compare equal
- * using their address in the list1 array, ensuring stabilty.
+ * using their address in the list1 array, ensuring stability.
  * This leaves us with something looking like
  *
  *  indir                  list1
@@ -1317,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);
@@ -1330,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);
@@ -1346,10 +1347,9 @@ 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) {
-        register gptr **pp, *q;
-        register size_t n, j, i;
+        gptr **pp, *q;
+        size_t n, j, i;
         gptr *small[SMALLSORT], **indir, tmp;
         SVCOMPARE_t savecmp;
         if (nmemb <= 1) return;     /* sorted trivially */
@@ -1374,7 +1374,7 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
         q = list1;
         for (n = nmemb; n--; ) {
              /* Assert A: all elements of q with index > n are already
-              * in place.  This is vacuosly true at the start, and we
+              * in place.  This is vacuously true at the start, and we
               * put element n where it belongs below (if it wasn't
               * already where it belonged). Assert B: we only move
               * elements that aren't where they belong,
@@ -1428,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_len(av)+1, Perl_sv_cmp_locale);
+    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
@@ -1470,17 +1470,17 @@ Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 
 PP(pp_sort)
 {
-    dVAR; dSP; dMARK; dORIGMARK;
-    register SV **p1 = ORIGMARK+1, **p2;
-    register I32 max, i;
+    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;
     OP* const nextop = PL_op->op_next;
     I32 overloading = 0;
     bool hasargs = FALSE;
+    bool copytmps;
     I32 is_xsub = 0;
     I32 sorting_av = 0;
     const U8 priv = PL_op->op_private;
@@ -1507,29 +1507,46 @@ 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 {
-           cv = sv_2cv(*++MARK, &stash, &gv, 0);
+           GV *autogv = NULL;
+           HV *stash;
+           cv = sv_2cv(*++MARK, &stash, &gv, GV_ADD);
+         check_cv:
            if (cv && SvPOK(cv)) {
                const char * const proto = SvPV_nolen_const(MUTABLE_SV(cv));
                if (proto && strEQ(proto, "$$")) {
                    hasargs = TRUE;
                }
            }
-           if (!(cv && CvROOT(cv))) {
-               if (cv && CvISXSUB(cv)) {
-                   is_xsub = 1;
+           if (cv && CvISXSUB(cv) && CvXSUB(cv)) {
+               is_xsub = 1;
+           }
+           else if (!(cv && CvROOT(cv))) {
+               if (gv) {
+                   goto autoload;
                }
-               else if (gv) {
+               else if (!CvANON(cv) && (gv = CvGV(cv))) {
+                 if (cv != GvCV(gv)) cv = GvCV(gv);
+                autoload:
+                 if (!autogv && (
+                       autogv = gv_autoload_pvn(
+                           GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
+                           GvNAMEUTF8(gv) ? SVf_UTF8 : 0
+                       )
+                    )) {
+                   cv = GvCVu(autogv);
+                   goto check_cv;
+                 }
+                 else {
                    SV *tmpstr = sv_newmortal();
                    gv_efullname3(tmpstr, gv, NULL);
                    DIE(aTHX_ "Undefined sort subroutine \"%"SVf"\" called",
                        SVfARG(tmpstr));
+                 }
                }
                else {
                    DIE(aTHX_ "Undefined subroutine in sort");
@@ -1544,7 +1561,6 @@ PP(pp_sort)
     }
     else {
        PL_sortcop = NULL;
-       stash = CopSTASH(PL_curcop);
     }
 
     /* optimiser converts "@a = sort @a" to "sort \@a";
@@ -1566,9 +1582,12 @@ PP(pp_sort)
        }
        else {
            if (SvREADONLY(av))
-               Perl_croak(aTHX_ "%s", PL_no_modify);
+               Perl_croak_no_modify();
            else
+           {
                SvREADONLY_on(av);
+               save_pushptr((void *)av, SAVEt_READONLY_OFF);
+           }
            p1 = p2 = AvARRAY(av);
            sorting_av = 1;
        }
@@ -1581,39 +1600,34 @@ PP(pp_sort)
     /* shuffle stack down, removing optional initial cv (p1!=p2), plus
      * any nulls; also stringify or converting to integer or number as
      * required any args */
+    copytmps = !sorting_av && PL_sortcop;
     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);
            if (!PL_sortcop) {
                if (priv & OPpSORT_NUMERIC) {
                    if (priv & OPpSORT_INTEGER) {
-                       if (!SvIOK(*p1)) {
-                           if (SvAMAGIC(*p1))
-                               overloading = 1;
-                           else
-                               (void)sv_2iv(*p1);
-                       }
+                       if (!SvIOK(*p1))
+                           (void)sv_2iv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
                    }
                    else {
-                       if (!SvNSIOK(*p1)) {
-                           if (SvAMAGIC(*p1))
-                               overloading = 1;
-                           else
-                               (void)sv_2nv(*p1);
-                       }
+                       if (!SvNSIOK(*p1))
+                           (void)sv_2nv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
                        if (all_SIVs && !SvSIOK(*p1))
                            all_SIVs = 0;
                    }
                }
                else {
-                   if (!SvPOK(*p1)) {
-                       if (SvAMAGIC(*p1))
-                           overloading = 1;
-                       else
-                           (void)sv_2pv_flags(*p1, 0,
-                                              SV_GMAGIC|SV_CONST_RETURN);
-                   }
+                   if (!SvPOK(*p1))
+                       (void)sv_2pv_flags(*p1, 0,
+                           SV_GMAGIC|SV_CONST_RETURN|SV_SKIP_OVERLOAD);
                }
+               if (SvAMAGIC(*p1))
+                   overloading = 1;
            }
            p1++;
        }
@@ -1636,12 +1650,14 @@ PP(pp_sort)
            CATCH_SET(TRUE);
            PUSHSTACKi(PERLSI_SORT);
            if (!hasargs && !is_xsub) {
-               SAVESPTR(PL_firstgv);
-               SAVESPTR(PL_secondgv);
-               SAVESPTR(PL_sortstash);
-               PL_firstgv = gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV);
-               PL_secondgv = gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV);
-               PL_sortstash = stash;
+               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));
            }
@@ -1650,9 +1666,14 @@ PP(pp_sort)
            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) {
-                   AV* const padlist = CvPADLIST(cv);
+                   PADLIST * const padlist = CvPADLIST(cv);
 
                    if (++CvDEPTH(cv) >= 2) {
                        PERL_STACK_OVERFLOW_CHECK();
@@ -1681,9 +1702,12 @@ PP(pp_sort)
                    sort_flags);
 
            if (!(flags & OPf_SPECIAL)) {
-               LEAVESUB(cv);
-               if (!is_xsub)
-                   CvDEPTH(cv)--;
+               SV *sv;
+               /* Reset cx, in case the context stack has been
+                  reallocated. */
+               cx = &cxstack[cxstack_ix];
+               POPSUB(cx, sv);
+               LEAVESUB(sv);
            }
            POPBLOCK(cx,PL_curpm);
            PL_stack_sp = newsp;
@@ -1698,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) {
@@ -1741,10 +1769,13 @@ 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;
+    SV *resultsv;
+    PMOP * const pm = PL_curpm;
+    OP * const sortop = PL_op;
+    COP * const cop = PL_curcop;
  
     PERL_ARGS_ASSERT_SORTCV;
 
@@ -1753,31 +1784,50 @@ S_sortcv(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    if (PL_stack_sp != PL_stack_base + 1)
-       Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    if (!SvNIOKp(*PL_stack_sp))
-       Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
-    result = SvIV(*PL_stack_sp);
+    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;
+    }
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
     leave_scope(oldsaveix);
+    PL_curpm = pm;
     return result;
 }
 
 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;
     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;
 
+    if (AvREAL(av)) {
+       av_clear(av);
+       AvREAL_off(av);
+       AvREIFY_on(av);
+    }
     if (AvMAX(av) < 1) {
-       SV** ary = AvALLOC(av);
+       SV **ary = AvALLOC(av);
        if (AvARRAY(av) != ary) {
            AvMAX(av) += AvARRAY(av) - AvALLOC(av);
            AvARRAY(av) = ary;
@@ -1786,6 +1836,7 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
            AvMAX(av) = 1;
            Renew(ary,2,SV*);
            AvARRAY(av) = ary;
+           AvALLOC(av) = ary;
        }
     }
     AvFILLp(av) = 1;
@@ -1795,26 +1846,32 @@ S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
     PL_stack_sp = PL_stack_base;
     PL_op = PL_sortcop;
     CALLRUNOPS(aTHX);
-    if (PL_stack_sp != PL_stack_base + 1)
-       Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    if (!SvNIOKp(*PL_stack_sp))
-       Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
-    result = SvIV(*PL_stack_sp);
+    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;
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
     leave_scope(oldsaveix);
+    PL_curpm = pm;
     return result;
 }
 
 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);
     I32 result;
+    PMOP * const pm = PL_curpm;
 
     PERL_ARGS_ASSERT_SORTCV_XSUB;
 
@@ -1827,13 +1884,12 @@ S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
     (void)(*CvXSUB(cv))(aTHX_ cv);
     if (PL_stack_sp != PL_stack_base + 1)
        Perl_croak(aTHX_ "Sort subroutine didn't return single value");
-    if (!SvNIOKp(*PL_stack_sp))
-       Perl_croak(aTHX_ "Sort subroutine didn't return a numeric value");
     result = SvIV(*PL_stack_sp);
     while (PL_scopestack_ix > oldscopeix) {
        LEAVE;
     }
     leave_scope(oldsaveix);
+    PL_curpm = pm;
     return result;
 }
 
@@ -1846,6 +1902,14 @@ S_sv_ncmp(pTHX_ SV *const a, SV *const b)
 
     PERL_ARGS_ASSERT_SV_NCMP;
 
+#if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan)
+    if (Perl_isnan(nv1) || Perl_isnan(nv2)) {
+#else
+    if (nv1 != nv1 || nv2 != nv2) {
+#endif
+       if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL);
+       return 0;
+    }
     return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
 }
 
@@ -1861,17 +1925,16 @@ S_sv_i_ncmp(pTHX_ SV *const a, SV *const b)
 }
 
 #define tryCALL_AMAGICbin(left,right,meth) \
-    (PL_amagic_generation && (SvAMAGIC(left)||SvAMAGIC(right))) \
-       ? amagic_call(left, right, CAT2(meth,_amg), 0) \
+    (SvAMAGIC(left)||SvAMAGIC(right)) \
+       ? amagic_call(left, right, meth, 0) \
        : NULL;
 
 #define SORT_NORMAL_RETURN_VALUE(val)  (((val) > 0) ? 1 : ((val) ? -1 : 0))
 
 static I32
-S_amagic_ncmp(pTHX_ register SV *const a, register SV *const b)
+S_amagic_ncmp(pTHX_ SV *const a, SV *const b)
 {
-    dVAR;
-    SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
+    SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_NCMP;
 
@@ -1889,10 +1952,9 @@ S_amagic_ncmp(pTHX_ register SV *const a, register SV *const b)
 }
 
 static I32
-S_amagic_i_ncmp(pTHX_ register SV *const a, register SV *const b)
+S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b)
 {
-    dVAR;
-    SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp);
+    SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
 
@@ -1910,10 +1972,9 @@ S_amagic_i_ncmp(pTHX_ register SV *const a, register SV *const b)
 }
 
 static I32
-S_amagic_cmp(pTHX_ register SV *const str1, register SV *const str2)
+S_amagic_cmp(pTHX_ SV *const str1, SV *const str2)
 {
-    dVAR;
-    SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
+    SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_CMP;
 
@@ -1930,11 +1991,12 @@ S_amagic_cmp(pTHX_ register SV *const str1, register SV *const str2)
     return sv_cmp(str1, str2);
 }
 
+#ifdef USE_LOCALE_COLLATE
+
 static I32
-S_amagic_cmp_locale(pTHX_ register SV *const str1, register SV *const str2)
+S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
 {
-    dVAR;
-    SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp);
+    SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
 
     PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;
 
@@ -1951,12 +2013,14 @@ S_amagic_cmp_locale(pTHX_ register SV *const str1, register SV *const str2)
     return sv_cmp_locale(str1, str2);
 }
 
+#endif
+
 /*
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */