Implement the sort pragma. Split sort code from pp_ctl.c

to pp_sort.c.  Includes the quicksort stabilizing layer
from John P. Linderman.  -Msort=qsort or -Msort=fast is
faster than without (or with -Msort=mergesort or -Msort=safe)
for short random inputs, but for some reason not quite as fast
as 5.6.1 qsort.  More benchmarking, profiling, tuning, and
optimizing definitely needed.

p4raw-id: //depot/perl@13179

1 files changed, 1 insertions, 771 deletions

diff --git a/pp_ctl.c b/pp_ctl.c
index 35f123fc7a..46a900a9c3 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -26,20 +26,8 @@
 
 #define DOCATCH(o) ((CATCH_GET == TRUE) ? docatch(o) : (o))
 
-static I32 sortcv(pTHX_ SV *a, SV *b);
-static I32 sortcv_stacked(pTHX_ SV *a, SV *b);
-static I32 sortcv_xsub(pTHX_ SV *a, SV *b);
-static I32 sv_ncmp(pTHX_ SV *a, SV *b);
-static I32 sv_i_ncmp(pTHX_ SV *a, SV *b);
-static I32 amagic_ncmp(pTHX_ SV *a, SV *b);
-static I32 amagic_i_ncmp(pTHX_ SV *a, SV *b);
-static I32 amagic_cmp(pTHX_ SV *a, SV *b);
-static I32 amagic_cmp_locale(pTHX_ SV *a, SV *b);
 static I32 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen);
 
-#define sv_cmp_static Perl_sv_cmp
-#define sv_cmp_locale_static Perl_sv_cmp_locale
-
 PP(pp_wantarray)
 {
     dSP;
@@ -885,179 +873,6 @@ PP(pp_mapwhile)
     }
 }
 
-PP(pp_sort)
-{
-    dSP; dMARK; dORIGMARK;
-    register SV **up;
-    SV **myorigmark = ORIGMARK;
-    register I32 max;
-    HV *stash;
-    GV *gv;
-    CV *cv = 0;
-    I32 gimme = GIMME;
-    OP* nextop = PL_op->op_next;
-    I32 overloading = 0;
-    bool hasargs = FALSE;
-    I32 is_xsub = 0;
-
-    if (gimme != G_ARRAY) {
-	SP = MARK;
-	RETPUSHUNDEF;
-    }
-
-    ENTER;
-    SAVEVPTR(PL_sortcop);
-    if (PL_op->op_flags & OPf_STACKED) {
-	if (PL_op->op_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);
-	}
-	else {
-	    cv = sv_2cv(*++MARK, &stash, &gv, 0);
-	    if (cv && SvPOK(cv)) {
-		STRLEN n_a;
-		char *proto = SvPV((SV*)cv, n_a);
-		if (proto && strEQ(proto, "$$")) {
-		    hasargs = TRUE;
-		}
-	    }
-	    if (!(cv && CvROOT(cv))) {
-		if (cv && CvXSUB(cv)) {
-		    is_xsub = 1;
-		}
-		else if (gv) {
-		    SV *tmpstr = sv_newmortal();
-		    gv_efullname3(tmpstr, gv, Nullch);
-		    DIE(aTHX_ "Undefined sort subroutine \"%s\" called",
-			SvPVX(tmpstr));
-		}
-		else {
-		    DIE(aTHX_ "Undefined subroutine in sort");
-		}
-	    }
-
-	    if (is_xsub)
-		PL_sortcop = (OP*)cv;
-	    else {
-		PL_sortcop = CvSTART(cv);
-		SAVEVPTR(CvROOT(cv)->op_ppaddr);
-		CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL];
-
-		SAVEVPTR(PL_curpad);
-		PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]);
-            }
-	}
-    }
-    else {
-	PL_sortcop = Nullop;
-	stash = CopSTASH(PL_curcop);
-    }
-
-    up = myorigmark + 1;
-    while (MARK < SP) {	/* This may or may not shift down one here. */
-	/*SUPPRESS 560*/
-	if ((*up = *++MARK)) {			/* Weed out nulls. */
-	    SvTEMP_off(*up);
-	    if (!PL_sortcop && !SvPOK(*up)) {
-		STRLEN n_a;
-	        if (SvAMAGIC(*up))
-	            overloading = 1;
-	        else
-		    (void)sv_2pv(*up, &n_a);
-	    }
-	    up++;
-	}
-    }
-    max = --up - myorigmark;
-    if (PL_sortcop) {
-	if (max > 1) {
-	    PERL_CONTEXT *cx;
-	    SV** newsp;
-	    bool oldcatch = CATCH_GET;
-
-	    SAVETMPS;
-	    SAVEOP();
-
-	    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;
-		}
-#ifdef USE_5005THREADS
-		sv_lock((SV *)PL_firstgv);
-		sv_lock((SV *)PL_secondgv);
-#endif
-		SAVESPTR(GvSV(PL_firstgv));
-		SAVESPTR(GvSV(PL_secondgv));
-	    }
-
-	    PUSHBLOCK(cx, CXt_NULL, PL_stack_base);
-	    if (!(PL_op->op_flags & OPf_SPECIAL)) {
-		cx->cx_type = CXt_SUB;
-		cx->blk_gimme = G_SCALAR;
-		PUSHSUB(cx);
-		if (!CvDEPTH(cv))
-		    (void)SvREFCNT_inc(cv); /* in preparation for POPSUB */
-	    }
-	    PL_sortcxix = cxstack_ix;
-
-	    if (hasargs && !is_xsub) {
-		/* This is mostly copied from pp_entersub */
-		AV *av = (AV*)PL_curpad[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->blk_sub.argarray = av;
-	    }
-           sortsv((myorigmark+1), max,
-                  is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv);
-
-	    POPBLOCK(cx,PL_curpm);
-	    PL_stack_sp = newsp;
-	    POPSTACK;
-	    CATCH_SET(oldcatch);
-	}
-    }
-    else {
-	if (max > 1) {
-	    MEXTEND(SP, 20);	/* Can't afford stack realloc on signal. */
-           sortsv(ORIGMARK+1, max,
-                  (PL_op->op_private & OPpSORT_NUMERIC)
-			? ( (PL_op->op_private & OPpSORT_INTEGER)
-			    ? ( overloading ? amagic_i_ncmp : sv_i_ncmp)
-			    : ( overloading ? amagic_ncmp : sv_ncmp))
-			: ( IN_LOCALE_RUNTIME
-			    ? ( overloading
-				? amagic_cmp_locale
-				: sv_cmp_locale_static)
-			    : ( overloading ? amagic_cmp : sv_cmp_static)));
-	    if (PL_op->op_private & OPpSORT_REVERSE) {
-		SV **p = ORIGMARK+1;
-		SV **q = ORIGMARK+max;
-		while (p < q) {
-		    SV *tmp = *p;
-		    *p++ = *q;
-		    *q-- = tmp;
-		}
-	    }
-	}
-    }
-    LEAVE;
-    PL_stack_sp = ORIGMARK + max;
-    return nextop;
-}
-
 /* Range stuff. */
 
 PP(pp_range)
@@ -3813,592 +3628,6 @@ S_doparseform(pTHX_ SV *sv)
     SvCOMPILED_on(sv);
 }
 
-/*
- * The mergesort implementation is by Peter M. Mcilroy <pmcilroy@lucent.com>.
- *
- * 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)
- *
- * The integration to Perl is by John P. Linderman <jpl@research.att.com>.
- *
- * The code can be distributed under the same terms as Perl itself.
- *
- */
-
-#ifdef	TESTHARNESS
-#include <sys/types.h>
-typedef	void SV;
-#define pTHX_
-#define STATIC
-#define New(ID,VAR,N,TYPE) VAR=(TYPE *)malloc((N)*sizeof(TYPE))
-#define	Safefree(VAR) free(VAR)
-typedef int  (*SVCOMPARE_t) (pTHX_ SV*, SV*);
-#endif	/* TESTHARNESS */
-
-typedef char * aptr;		/* pointer for arithmetic on sizes */
-typedef SV * gptr;		/* pointers in our lists */
-
-/* Binary merge internal sort, with a few special mods
-** for the special perl environment it now finds itself in.
-**
-** Things that were once options have been hotwired
-** to values suitable for this use.  In particular, we'll always
-** initialize looking for natural runs, we'll always produce stable
-** output, and we'll always do Peter McIlroy's binary merge.
-*/
-
-/* Pointer types for arithmetic and storage and convenience casts */
-
-#define	APTR(P)	((aptr)(P))
-#define	GPTP(P)	((gptr *)(P))
-#define GPPP(P) ((gptr **)(P))
-
-
-/* byte offset from pointer P to (larger) pointer Q */
-#define	BYTEOFF(P, Q) (APTR(Q) - APTR(P))
-
-#define PSIZE sizeof(gptr)
-
-/* If PSIZE is power of 2, make PSHIFT that power, if that helps */
-
-#ifdef	PSHIFT
-#define	PNELEM(P, Q)	(BYTEOFF(P,Q) >> (PSHIFT))
-#define	PNBYTE(N)	((N) << (PSHIFT))
-#define	PINDEX(P, N)	(GPTP(APTR(P) + PNBYTE(N)))
-#else
-/* Leave optimization to compiler */
-#define	PNELEM(P, Q)	(GPTP(Q) - GPTP(P))
-#define	PNBYTE(N)	((N) * (PSIZE))
-#define	PINDEX(P, N)	(GPTP(P) + (N))
-#endif
-
-/* Pointer into other corresponding to pointer into this */
-#define	POTHER(P, THIS, OTHER) GPTP(APTR(OTHER) + BYTEOFF(THIS,P))
-
-#define FROMTOUPTO(src, dst, lim) do *dst++ = *src++; while(src<lim)
-
-
-/* Runs are identified by a pointer in the auxilliary 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.
-*/
-
-#define	NEXT(P)		(*GPPP(P))
-
-
-/* PTHRESH is the minimum number of pairs with the same sense to justify
-** checking for a run and extending it.  Note that PTHRESH counts PAIRS,
-** not just elements, so PTHRESH == 8 means a run of 16.
-*/
-
-#define	PTHRESH (8)
-
-/* RTHRESH is the number of elements in a run that must compare low
-** to the low element from the opposing run before we justify
-** doing a binary rampup instead of single stepping.
-** In random input, N in a row low should only happen with
-** probability 2^(1-N), so we can risk that we are dealing
-** with orderly input without paying much when we aren't.
-*/
-
-#define RTHRESH (6)
-
-
-/*
-** Overview of algorithm and variables.
-** The array of elements at list1 will be organized into runs of length 2,
-** or runs of length >= 2 * PTHRESH.  We only try to form long runs when
-** PTHRESH adjacent pairs compare in the same way, suggesting overall order.
-**
-** Unless otherwise specified, pair pointers address the first of two elements.
-**
-** b and b+1 are a pair that compare with sense ``sense''.
-** b is the ``bottom'' of adjacent pairs that might form a longer run.
-**
-** p2 parallels b in the list2 array, where runs are defined by
-** a pointer chain.
-**
-** t represents the ``top'' of the adjacent pairs that might extend
-** the run beginning at b.  Usually, t addresses a pair
-** that compares with opposite sense from (b,b+1).
-** However, it may also address a singleton element at the end of list1,
-** or it may be equal to ``last'', the first element beyond list1.
-**
-** r addresses the Nth pair following b.  If this would be beyond t,
-** we back it off to t.  Only when r is less than t do we consider the
-** run long enough to consider checking.
-**
-** q addresses a pair such that the pairs at b through q already form a run.
-** Often, q will equal b, indicating we only are sure of the pair itself.
-** However, a search on the previous cycle may have revealed a longer run,
-** so q may be greater than b.
-**
-** p is used to work back from a candidate r, trying to reach q,
-** which would mean b through r would be a run.  If we discover such a run,
-** we start q at r and try to push it further towards t.
-** If b through r is NOT a run, we detect the wrong order at (p-1,p).
-** In any event, after the check (if any), we have two main cases.
-**
-** 1) Short run.  b <= q < p <= r <= t.
-**	b through q is a run (perhaps trivial)
-**	q through p are uninteresting pairs
-**	p through r is a run
-**
-** 2) Long run.  b < r <= q < t.
-**	b through q is a run (of length >= 2 * PTHRESH)
-**
-** Note that degenerate cases are not only possible, but likely.
-** For example, if the pair following b compares with opposite sense,
-** then b == q < p == r == t.
-*/
-
-
-static void
-dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp)
-{
-    int sense;
-    register gptr *b, *p, *q, *t, *p2;
-    register gptr c, *last, *r;
-    gptr *savep;
-
-    b = list1;
-    last = PINDEX(b, nmemb);
-    sense = (cmp(aTHX_ *b, *(b+1)) > 0);
-    for (p2 = list2; b < last; ) {
-	/* We just started, or just reversed sense.
-	** Set t at end of pairs with the prevailing sense.
-	*/
-	for (p = b+2, t = p; ++p < last; t = ++p) {
-	    if ((cmp(aTHX_ *t, *p) > 0) != sense) break;
-	}
-	q = b;
-	/* Having laid out the playing field, look for long runs */
-	do {
-	    p = r = b + (2 * PTHRESH);
-	    if (r >= t) p = r = t;	/* too short to care about */
-	    else {
-		while (((cmp(aTHX_ *(p-1), *p) > 0) == sense) &&
-		       ((p -= 2) > q));
-		if (p <= q) {
-		    /* b through r is a (long) run.
-		    ** Extend it as far as possible.
-		    */
-		    p = q = r;
-		    while (((p += 2) < t) &&
-			   ((cmp(aTHX_ *(p-1), *p) > 0) == sense)) q = p;
-		    r = p = q + 2;	/* no simple pairs, no after-run */
-		}
-	    }
-	    if (q > b) {		/* run of greater than 2 at b */
-		savep = p;
-		p = q += 2;
-		/* pick up singleton, if possible */
-		if ((p == t) &&
-		    ((t + 1) == last) &&
-		    ((cmp(aTHX_ *(p-1), *p) > 0) == sense))
-		    savep = r = p = q = last;
-		p2 = NEXT(p2) = p2 + (p - b);
-		if (sense) while (b < --p) {
-		    c = *b;
-		    *b++ = *p;
-		    *p = c;
-		}
-		p = savep;
-	    }
-	    while (q < p) {		/* simple pairs */
-		p2 = NEXT(p2) = p2 + 2;
-		if (sense) {
-		    c = *q++;
-		    *(q-1) = *q;
-		    *q++ = c;
-		} else q += 2;
-	    }
-	    if (((b = p) == t) && ((t+1) == last)) {
-		NEXT(p2) = p2 + 1;
-		b++;
-	    }
-	    q = r;
-	} while (b < t);
-	sense = !sense;
-    }
-    return;
-}
-
-
-/* Overview of bmerge variables:
-**
-** list1 and list2 address the main and auxiliary arrays.
-** They swap identities after each merge pass.
-** Base points to the original list1, so we can tell if
-** the pointers ended up where they belonged (or must be copied).
-**
-** When we are merging two lists, f1 and f2 are the next elements
-** on the respective lists.  l1 and l2 mark the end of the lists.
-** tp2 is the current location in the merged list.
-**
-** p1 records where f1 started.
-** After the merge, a new descriptor is built there.
-**
-** p2 is a ``parallel'' pointer in (what starts as) descriptor space.
-** It is used to identify and delimit the runs.
-**
-** In the heat of determining where q, the greater of the f1/f2 elements,
-** belongs in the other list, b, t and p, represent bottom, top and probe
-** locations, respectively, in the other list.
-** They make convenient temporary pointers in other places.
-*/
-
-/* 
-=for apidoc sortsv
-
-Sort an array. Here is an example:
-
-    sortsv(AvARRAY(av), av_len(av)+1, Perl_sv_cmp_locale); 
-
-=cut
-*/
-    
-void
-Perl_sortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp)
-{
-    int i, run;
-    int sense;
-    register gptr *f1, *f2, *t, *b, *p, *tp2, *l1, *l2, *q;
-    gptr *aux, *list2, *p2, *last;
-    gptr *base = list1;
-    gptr *p1;
-
-    if (nmemb <= 1) return;	/* sorted trivially */
-    New(799,list2,nmemb,gptr);	/* allocate auxilliary array */
-    aux = list2;
-    dynprep(aTHX_ list1, list2, nmemb, cmp);
-    last = PINDEX(list2, nmemb);
-    while (NEXT(list2) != last) {
-	/* More than one run remains.  Do some merging to reduce runs. */
-	l2 = p1 = list1;
-	for (tp2 = p2 = list2; p2 != last;) {
-	    /* The new first run begins where the old second list ended.
-	    ** Use the p2 ``parallel'' pointer to identify the end of the run.
-	    */
-	    f1 = l2;
-	    t = NEXT(p2);
-	    f2 = l1 = POTHER(t, list2, list1);
-	    if (t != last) t = NEXT(t);
-	    l2 = POTHER(t, list2, list1);
-	    p2 = t;
-	    while (f1 < l1 && f2 < l2) {
-		/* If head 1 is larger than head 2, find ALL the elements
-		** in list 2 strictly less than head1, write them all,
-		** then head 1.  Then compare the new heads, and repeat,
-		** until one or both lists are exhausted.
-		**
-		** In all comparisons (after establishing
-		** which head to merge) the item to merge
-		** (at pointer q) is the first operand of
-		** the comparison.  When we want to know
-		** if ``q is strictly less than the other'',
-		** we can't just do
-		**    cmp(q, other) < 0
-		** because stability demands that we treat equality
-		** as high when q comes from l2, and as low when
-		** q was from l1.  So we ask the question by doing
-		**    cmp(q, other) <= sense
-		** and make sense == 0 when equality should look low,
-		** and -1 when equality should look high.
-		*/
-
-
-		if (cmp(aTHX_ *f1, *f2) <= 0) {
-		    q = f2; b = f1; t = l1;
-		    sense = -1;
-		} else {
-		    q = f1; b = f2; t = l2;
-		    sense = 0;
-		}
-
-
-		/* ramp up
-		**
-		** Leave t at something strictly
-		** greater than q (or at the end of the list),
-		** and b at something strictly less than q.
-		*/
-		for (i = 1, run = 0 ;;) {
-		    if ((p = PINDEX(b, i)) >= t) {
-			/* off the end */
-			if (((p = PINDEX(t, -1)) > b) &&
-			    (cmp(aTHX_ *q, *p) <= sense))
-			     t = p;
-			else b = p;
-			break;
-		    } else if (cmp(aTHX_ *q, *p) <= sense) {
-			t = p;
-			break;
-		    } else b = p;
-		    if (++run >= RTHRESH) i += i;
-		}
-
-
-		/* q is known to follow b and must be inserted before t.
-		** Increment b, so the range of possibilities is [b,t).
-		** Round binary split down, to favor early appearance.
-		** Adjust b and t until q belongs just before t.
-		*/
-
-		b++;
-		while (b < t) {
-		    p = PINDEX(b, (PNELEM(b, t) - 1) / 2);
-		    if (cmp(aTHX_ *q, *p) <= sense) {
-			t = p;
-		    } else b = p + 1;
-		}
-
-
-		/* Copy all the strictly low elements */
-
-		if (q == f1) {
-		    FROMTOUPTO(f2, tp2, t);
-		    *tp2++ = *f1++;
-		} else {
-		    FROMTOUPTO(f1, tp2, t);
-		    *tp2++ = *f2++;
-		}
-	    }
-
-
-	    /* Run out remaining list */
-	    if (f1 == l1) {
-		   if (f2 < l2) FROMTOUPTO(f2, tp2, l2);
-	    } else              FROMTOUPTO(f1, tp2, l1);
-	    p1 = NEXT(p1) = POTHER(tp2, list2, list1);
-	}
-	t = list1;
-	list1 = list2;
-	list2 = t;
-	last = PINDEX(list2, nmemb);
-    }
-    if (base == list2) {
-	last = PINDEX(list1, nmemb);
-	FROMTOUPTO(list1, list2, last);
-    }
-    Safefree(aux);
-    return;
-}
-
-static I32
-sortcv(pTHX_ SV *a, SV *b)
-{
-    I32 oldsaveix = PL_savestack_ix;
-    I32 oldscopeix = PL_scopestack_ix;
-    I32 result;
-    GvSV(PL_firstgv) = a;
-    GvSV(PL_secondgv) = 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);
-    while (PL_scopestack_ix > oldscopeix) {
-	LEAVE;
-    }
-    leave_scope(oldsaveix);
-    return result;
-}
-
-static I32
-sortcv_stacked(pTHX_ SV *a, SV *b)
-{
-    I32 oldsaveix = PL_savestack_ix;
-    I32 oldscopeix = PL_scopestack_ix;
-    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);
-	if (AvARRAY(av) != ary) {
-	    AvMAX(av) += AvARRAY(av) - AvALLOC(av);
-	    SvPVX(av) = (char*)ary;
-	}
-	if (AvMAX(av) < 1) {
-	    AvMAX(av) = 1;
-	    Renew(ary,2,SV*);
-	    SvPVX(av) = (char*)ary;
-	}
-    }
-    AvFILLp(av) = 1;
-
-    AvARRAY(av)[0] = a;
-    AvARRAY(av)[1] = 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);
-    while (PL_scopestack_ix > oldscopeix) {
-	LEAVE;
-    }
-    leave_scope(oldsaveix);
-    return result;
-}
-
-static I32
-sortcv_xsub(pTHX_ SV *a, SV *b)
-{
-    dSP;
-    I32 oldsaveix = PL_savestack_ix;
-    I32 oldscopeix = PL_scopestack_ix;
-    I32 result;
-    CV *cv=(CV*)PL_sortcop;
-
-    SP = PL_stack_base;
-    PUSHMARK(SP);
-    EXTEND(SP, 2);
-    *++SP = a;
-    *++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");
-    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);
-    return result;
-}
-
-
-static I32
-sv_ncmp(pTHX_ SV *a, SV *b)
-{
-    NV nv1 = SvNV(a);
-    NV nv2 = SvNV(b);
-    return nv1 < nv2 ? -1 : nv1 > nv2 ? 1 : 0;
-}
-
-static I32
-sv_i_ncmp(pTHX_ SV *a, SV *b)
-{
-    IV iv1 = SvIV(a);
-    IV iv2 = SvIV(b);
-    return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
-}
-#define tryCALL_AMAGICbin(left,right,meth,svp) STMT_START { \
-	  *svp = Nullsv;				\
-          if (PL_amagic_generation) { \
-	    if (SvAMAGIC(left)||SvAMAGIC(right))\
-		*svp = amagic_call(left, \
-				   right, \
-				   CAT2(meth,_amg), \
-				   0); \
-	  } \
-	} STMT_END
-
-static I32
-amagic_ncmp(pTHX_ register SV *a, register SV *b)
-{
-    SV *tmpsv;
-    tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
-    if (tmpsv) {
-    	NV d;
-    	
-        if (SvIOK(tmpsv)) {
-            I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
-        }
-        d = SvNV(tmpsv);
-        if (d > 0)
-           return 1;
-        return d? -1 : 0;
-     }
-     return sv_ncmp(aTHX_ a, b);
-}
-
-static I32
-amagic_i_ncmp(pTHX_ register SV *a, register SV *b)
-{
-    SV *tmpsv;
-    tryCALL_AMAGICbin(a,b,ncmp,&tmpsv);
-    if (tmpsv) {
-    	NV d;
-    	
-        if (SvIOK(tmpsv)) {
-            I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
-        }
-        d = SvNV(tmpsv);
-        if (d > 0)
-           return 1;
-        return d? -1 : 0;
-    }
-    return sv_i_ncmp(aTHX_ a, b);
-}
-
-static I32
-amagic_cmp(pTHX_ register SV *str1, register SV *str2)
-{
-    SV *tmpsv;
-    tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
-    if (tmpsv) {
-    	NV d;
-    	
-        if (SvIOK(tmpsv)) {
-            I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
-        }
-        d = SvNV(tmpsv);
-        if (d > 0)
-           return 1;
-        return d? -1 : 0;
-    }
-    return sv_cmp(str1, str2);
-}
-
-static I32
-amagic_cmp_locale(pTHX_ register SV *str1, register SV *str2)
-{
-    SV *tmpsv;
-    tryCALL_AMAGICbin(str1,str2,scmp,&tmpsv);
-    if (tmpsv) {
-    	NV d;
-    	
-        if (SvIOK(tmpsv)) {
-            I32 i = SvIVX(tmpsv);
-            if (i > 0)
-               return 1;
-            return i? -1 : 0;
-        }
-        d = SvNV(tmpsv);
-        if (d > 0)
-           return 1;
-        return d? -1 : 0;
-    }
-    return sv_cmp_locale(str1, str2);
-}
-
 static I32
 run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 {
@@ -4468,3 +3697,4 @@ run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 
     return len;
 }
+