This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
pp_sort.c: fix fencepost error in call to av_extend()
[perl5.git] / pp_sort.c
1 /*    pp_sort.c
2  *
3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
4  *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 by Larry Wall and others
5  *
6  *    You may distribute under the terms of either the GNU General Public
7  *    License or the Artistic License, as specified in the README file.
8  *
9  */
10
11 /*
12  *   ...they shuffled back towards the rear of the line.  'No, not at the
13  *   rear!' the slave-driver shouted.  'Three files up. And stay there...
14  *
15  *     [p.931 of _The Lord of the Rings_, VI/ii: "The Land of Shadow"]
16  */
17
18 /* This file contains pp ("push/pop") functions that
19  * execute the opcodes that make up a perl program. A typical pp function
20  * expects to find its arguments on the stack, and usually pushes its
21  * results onto the stack, hence the 'pp' terminology. Each OP structure
22  * contains a pointer to the relevant pp_foo() function.
23  *
24  * This particular file just contains pp_sort(), which is complex
25  * enough to merit its own file! See the other pp*.c files for the rest of
26  * the pp_ functions.
27  */
28
29 #include "EXTERN.h"
30 #define PERL_IN_PP_SORT_C
31 #include "perl.h"
32
33 #define sv_cmp_static Perl_sv_cmp
34 #define sv_cmp_locale_static Perl_sv_cmp_locale
35
36 #ifndef SMALLSORT
37 #define SMALLSORT (200)
38 #endif
39
40 /* Flags for qsortsv and mergesortsv */
41 #define SORTf_DESC   1
42 #define SORTf_STABLE 2
43 #define SORTf_UNSTABLE 8
44
45 /*
46  * The mergesort implementation is by Peter M. Mcilroy <pmcilroy@lucent.com>.
47  *
48  * The original code was written in conjunction with BSD Computer Software
49  * Research Group at University of California, Berkeley.
50  *
51  * See also: "Optimistic Sorting and Information Theoretic Complexity"
52  *           Peter McIlroy
53  *           SODA (Fourth Annual ACM-SIAM Symposium on Discrete Algorithms),
54  *           pp 467-474, Austin, Texas, 25-27 January 1993.
55  *
56  * The integration to Perl is by John P. Linderman <jpl.jpl@gmail.com>.
57  *
58  * The code can be distributed under the same terms as Perl itself.
59  *
60  */
61
62
63 typedef char * aptr;            /* pointer for arithmetic on sizes */
64 typedef SV * gptr;              /* pointers in our lists */
65
66 /* Binary merge internal sort, with a few special mods
67 ** for the special perl environment it now finds itself in.
68 **
69 ** Things that were once options have been hotwired
70 ** to values suitable for this use.  In particular, we'll always
71 ** initialize looking for natural runs, we'll always produce stable
72 ** output, and we'll always do Peter McIlroy's binary merge.
73 */
74
75 /* Pointer types for arithmetic and storage and convenience casts */
76
77 #define APTR(P) ((aptr)(P))
78 #define GPTP(P) ((gptr *)(P))
79 #define GPPP(P) ((gptr **)(P))
80
81
82 /* byte offset from pointer P to (larger) pointer Q */
83 #define BYTEOFF(P, Q) (APTR(Q) - APTR(P))
84
85 #define PSIZE sizeof(gptr)
86
87 /* If PSIZE is power of 2, make PSHIFT that power, if that helps */
88
89 #ifdef  PSHIFT
90 #define PNELEM(P, Q)    (BYTEOFF(P,Q) >> (PSHIFT))
91 #define PNBYTE(N)       ((N) << (PSHIFT))
92 #define PINDEX(P, N)    (GPTP(APTR(P) + PNBYTE(N)))
93 #else
94 /* Leave optimization to compiler */
95 #define PNELEM(P, Q)    (GPTP(Q) - GPTP(P))
96 #define PNBYTE(N)       ((N) * (PSIZE))
97 #define PINDEX(P, N)    (GPTP(P) + (N))
98 #endif
99
100 /* Pointer into other corresponding to pointer into this */
101 #define POTHER(P, THIS, OTHER) GPTP(APTR(OTHER) + BYTEOFF(THIS,P))
102
103 #define FROMTOUPTO(src, dst, lim) do *dst++ = *src++; while(src<lim)
104
105
106 /* Runs are identified by a pointer in the auxiliary list.
107 ** The pointer is at the start of the list,
108 ** and it points to the start of the next list.
109 ** NEXT is used as an lvalue, too.
110 */
111
112 #define NEXT(P)         (*GPPP(P))
113
114
115 /* PTHRESH is the minimum number of pairs with the same sense to justify
116 ** checking for a run and extending it.  Note that PTHRESH counts PAIRS,
117 ** not just elements, so PTHRESH == 8 means a run of 16.
118 */
119
120 #define PTHRESH (8)
121
122 /* RTHRESH is the number of elements in a run that must compare low
123 ** to the low element from the opposing run before we justify
124 ** doing a binary rampup instead of single stepping.
125 ** In random input, N in a row low should only happen with
126 ** probability 2^(1-N), so we can risk that we are dealing
127 ** with orderly input without paying much when we aren't.
128 */
129
130 #define RTHRESH (6)
131
132
133 /*
134 ** Overview of algorithm and variables.
135 ** The array of elements at list1 will be organized into runs of length 2,
136 ** or runs of length >= 2 * PTHRESH.  We only try to form long runs when
137 ** PTHRESH adjacent pairs compare in the same way, suggesting overall order.
138 **
139 ** Unless otherwise specified, pair pointers address the first of two elements.
140 **
141 ** b and b+1 are a pair that compare with sense "sense".
142 ** b is the "bottom" of adjacent pairs that might form a longer run.
143 **
144 ** p2 parallels b in the list2 array, where runs are defined by
145 ** a pointer chain.
146 **
147 ** t represents the "top" of the adjacent pairs that might extend
148 ** the run beginning at b.  Usually, t addresses a pair
149 ** that compares with opposite sense from (b,b+1).
150 ** However, it may also address a singleton element at the end of list1,
151 ** or it may be equal to "last", the first element beyond list1.
152 **
153 ** r addresses the Nth pair following b.  If this would be beyond t,
154 ** we back it off to t.  Only when r is less than t do we consider the
155 ** run long enough to consider checking.
156 **
157 ** q addresses a pair such that the pairs at b through q already form a run.
158 ** Often, q will equal b, indicating we only are sure of the pair itself.
159 ** However, a search on the previous cycle may have revealed a longer run,
160 ** so q may be greater than b.
161 **
162 ** p is used to work back from a candidate r, trying to reach q,
163 ** which would mean b through r would be a run.  If we discover such a run,
164 ** we start q at r and try to push it further towards t.
165 ** If b through r is NOT a run, we detect the wrong order at (p-1,p).
166 ** In any event, after the check (if any), we have two main cases.
167 **
168 ** 1) Short run.  b <= q < p <= r <= t.
169 **      b through q is a run (perhaps trivial)
170 **      q through p are uninteresting pairs
171 **      p through r is a run
172 **
173 ** 2) Long run.  b < r <= q < t.
174 **      b through q is a run (of length >= 2 * PTHRESH)
175 **
176 ** Note that degenerate cases are not only possible, but likely.
177 ** For example, if the pair following b compares with opposite sense,
178 ** then b == q < p == r == t.
179 */
180
181
182 static IV
183 dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, const SVCOMPARE_t cmp)
184 {
185     I32 sense;
186     gptr *b, *p, *q, *t, *p2;
187     gptr *last, *r;
188     IV runs = 0;
189
190     b = list1;
191     last = PINDEX(b, nmemb);
192     sense = (cmp(aTHX_ *b, *(b+1)) > 0);
193     for (p2 = list2; b < last; ) {
194         /* We just started, or just reversed sense.
195         ** Set t at end of pairs with the prevailing sense.
196         */
197         for (p = b+2, t = p; ++p < last; t = ++p) {
198             if ((cmp(aTHX_ *t, *p) > 0) != sense) break;
199         }
200         q = b;
201         /* Having laid out the playing field, look for long runs */
202         do {
203             p = r = b + (2 * PTHRESH);
204             if (r >= t) p = r = t;      /* too short to care about */
205             else {
206                 while (((cmp(aTHX_ *(p-1), *p) > 0) == sense) &&
207                        ((p -= 2) > q)) {}
208                 if (p <= q) {
209                     /* b through r is a (long) run.
210                     ** Extend it as far as possible.
211                     */
212                     p = q = r;
213                     while (((p += 2) < t) &&
214                            ((cmp(aTHX_ *(p-1), *p) > 0) == sense)) q = p;
215                     r = p = q + 2;      /* no simple pairs, no after-run */
216                 }
217             }
218             if (q > b) {                /* run of greater than 2 at b */
219                 gptr *savep = p;
220
221                 p = q += 2;
222                 /* pick up singleton, if possible */
223                 if ((p == t) &&
224                     ((t + 1) == last) &&
225                     ((cmp(aTHX_ *(p-1), *p) > 0) == sense))
226                     savep = r = p = q = last;
227                 p2 = NEXT(p2) = p2 + (p - b); ++runs;
228                 if (sense)
229                     while (b < --p) {
230                         const gptr c = *b;
231                         *b++ = *p;
232                         *p = c;
233                     }
234                 p = savep;
235             }
236             while (q < p) {             /* simple pairs */
237                 p2 = NEXT(p2) = p2 + 2; ++runs;
238                 if (sense) {
239                     const gptr c = *q++;
240                     *(q-1) = *q;
241                     *q++ = c;
242                 } else q += 2;
243             }
244             if (((b = p) == t) && ((t+1) == last)) {
245                 NEXT(p2) = p2 + 1; ++runs;
246                 b++;
247             }
248             q = r;
249         } while (b < t);
250         sense = !sense;
251     }
252     return runs;
253 }
254
255
256 /* The original merge sort, in use since 5.7, was as fast as, or faster than,
257  * qsort on many platforms, but slower than qsort, conspicuously so,
258  * on others.  The most likely explanation was platform-specific
259  * differences in cache sizes and relative speeds.
260  *
261  * The quicksort divide-and-conquer algorithm guarantees that, as the
262  * problem is subdivided into smaller and smaller parts, the parts
263  * fit into smaller (and faster) caches.  So it doesn't matter how
264  * many levels of cache exist, quicksort will "find" them, and,
265  * as long as smaller is faster, take advantage of them.
266  *
267  * By contrast, consider how the original mergesort algorithm worked.
268  * Suppose we have five runs (each typically of length 2 after dynprep).
269  * 
270  * pass               base                        aux
271  *  0              1 2 3 4 5
272  *  1                                           12 34 5
273  *  2                1234 5
274  *  3                                            12345
275  *  4                 12345
276  *
277  * Adjacent pairs are merged in "grand sweeps" through the input.
278  * This means, on pass 1, the records in runs 1 and 2 aren't revisited until
279  * runs 3 and 4 are merged and the runs from run 5 have been copied.
280  * The only cache that matters is one large enough to hold *all* the input.
281  * On some platforms, this may be many times slower than smaller caches.
282  *
283  * The following pseudo-code uses the same basic merge algorithm,
284  * but in a divide-and-conquer way.
285  *
286  * # merge $runs runs at offset $offset of list $list1 into $list2.
287  * # all unmerged runs ($runs == 1) originate in list $base.
288  * sub mgsort2 {
289  *     my ($offset, $runs, $base, $list1, $list2) = @_;
290  *
291  *     if ($runs == 1) {
292  *         if ($list1 is $base) copy run to $list2
293  *         return offset of end of list (or copy)
294  *     } else {
295  *         $off2 = mgsort2($offset, $runs-($runs/2), $base, $list2, $list1)
296  *         mgsort2($off2, $runs/2, $base, $list2, $list1)
297  *         merge the adjacent runs at $offset of $list1 into $list2
298  *         return the offset of the end of the merged runs
299  *     }
300  * }
301  * mgsort2(0, $runs, $base, $aux, $base);
302  *
303  * For our 5 runs, the tree of calls looks like 
304  *
305  *           5
306  *      3        2
307  *   2     1   1   1
308  * 1   1
309  *
310  * 1   2   3   4   5
311  *
312  * and the corresponding activity looks like
313  *
314  * copy runs 1 and 2 from base to aux
315  * merge runs 1 and 2 from aux to base
316  * (run 3 is where it belongs, no copy needed)
317  * merge runs 12 and 3 from base to aux
318  * (runs 4 and 5 are where they belong, no copy needed)
319  * merge runs 4 and 5 from base to aux
320  * merge runs 123 and 45 from aux to base
321  *
322  * Note that we merge runs 1 and 2 immediately after copying them,
323  * while they are still likely to be in fast cache.  Similarly,
324  * run 3 is merged with run 12 while it still may be lingering in cache.
325  * This implementation should therefore enjoy much of the cache-friendly
326  * behavior that quicksort does.  In addition, it does less copying
327  * than the original mergesort implementation (only runs 1 and 2 are copied)
328  * and the "balancing" of merges is better (merged runs comprise more nearly
329  * equal numbers of original runs).
330  *
331  * The actual cache-friendly implementation will use a pseudo-stack
332  * to avoid recursion, and will unroll processing of runs of length 2,
333  * but it is otherwise similar to the recursive implementation.
334  */
335
336 typedef struct {
337     IV  offset;         /* offset of 1st of 2 runs at this level */
338     IV  runs;           /* how many runs must be combined into 1 */
339 } off_runs;             /* pseudo-stack element */
340
341
342 static I32
343 cmp_desc(pTHX_ gptr const a, gptr const b)
344 {
345     return -PL_sort_RealCmp(aTHX_ a, b);
346 }
347
348 /*
349 =head1 SV Manipulation Functions
350
351 =for apidoc sortsv_flags
352
353 In-place sort an array of SV pointers with the given comparison routine,
354 with various SORTf_* flag options.
355
356 =cut
357 */
358 void
359 Perl_sortsv_flags(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
360 {
361     IV i, run, offset;
362     I32 sense, level;
363     gptr *f1, *f2, *t, *b, *p;
364     int iwhich;
365     gptr *aux;
366     gptr *p1;
367     gptr small[SMALLSORT];
368     gptr *which[3];
369     off_runs stack[60], *stackp;
370     SVCOMPARE_t savecmp = NULL;
371
372     PERL_ARGS_ASSERT_SORTSV_FLAGS;
373     if (nmemb <= 1) return;                     /* sorted trivially */
374
375     if ((flags & SORTf_DESC) != 0) {
376         savecmp = PL_sort_RealCmp;      /* Save current comparison routine, if any */
377         PL_sort_RealCmp = cmp;  /* Put comparison routine where cmp_desc can find it */
378         cmp = cmp_desc;
379     }
380
381     if (nmemb <= SMALLSORT) aux = small;        /* use stack for aux array */
382     else { Newx(aux,nmemb,gptr); }              /* allocate auxiliary array */
383     level = 0;
384     stackp = stack;
385     stackp->runs = dynprep(aTHX_ base, aux, nmemb, cmp);
386     stackp->offset = offset = 0;
387     which[0] = which[2] = base;
388     which[1] = aux;
389     for (;;) {
390         /* On levels where both runs have be constructed (stackp->runs == 0),
391          * merge them, and note the offset of their end, in case the offset
392          * is needed at the next level up.  Hop up a level, and,
393          * as long as stackp->runs is 0, keep merging.
394          */
395         IV runs = stackp->runs;
396         if (runs == 0) {
397             gptr *list1, *list2;
398             iwhich = level & 1;
399             list1 = which[iwhich];              /* area where runs are now */
400             list2 = which[++iwhich];            /* area for merged runs */
401             do {
402                 gptr *l1, *l2, *tp2;
403                 offset = stackp->offset;
404                 f1 = p1 = list1 + offset;               /* start of first run */
405                 p = tp2 = list2 + offset;       /* where merged run will go */
406                 t = NEXT(p);                    /* where first run ends */
407                 f2 = l1 = POTHER(t, list2, list1); /* ... on the other side */
408                 t = NEXT(t);                    /* where second runs ends */
409                 l2 = POTHER(t, list2, list1);   /* ... on the other side */
410                 offset = PNELEM(list2, t);
411                 while (f1 < l1 && f2 < l2) {
412                     /* If head 1 is larger than head 2, find ALL the elements
413                     ** in list 2 strictly less than head1, write them all,
414                     ** then head 1.  Then compare the new heads, and repeat,
415                     ** until one or both lists are exhausted.
416                     **
417                     ** In all comparisons (after establishing
418                     ** which head to merge) the item to merge
419                     ** (at pointer q) is the first operand of
420                     ** the comparison.  When we want to know
421                     ** if "q is strictly less than the other",
422                     ** we can't just do
423                     **    cmp(q, other) < 0
424                     ** because stability demands that we treat equality
425                     ** as high when q comes from l2, and as low when
426                     ** q was from l1.  So we ask the question by doing
427                     **    cmp(q, other) <= sense
428                     ** and make sense == 0 when equality should look low,
429                     ** and -1 when equality should look high.
430                     */
431
432                     gptr *q;
433                     if (cmp(aTHX_ *f1, *f2) <= 0) {
434                         q = f2; b = f1; t = l1;
435                         sense = -1;
436                     } else {
437                         q = f1; b = f2; t = l2;
438                         sense = 0;
439                     }
440
441
442                     /* ramp up
443                     **
444                     ** Leave t at something strictly
445                     ** greater than q (or at the end of the list),
446                     ** and b at something strictly less than q.
447                     */
448                     for (i = 1, run = 0 ;;) {
449                         if ((p = PINDEX(b, i)) >= t) {
450                             /* off the end */
451                             if (((p = PINDEX(t, -1)) > b) &&
452                                 (cmp(aTHX_ *q, *p) <= sense))
453                                  t = p;
454                             else b = p;
455                             break;
456                         } else if (cmp(aTHX_ *q, *p) <= sense) {
457                             t = p;
458                             break;
459                         } else b = p;
460                         if (++run >= RTHRESH) i += i;
461                     }
462
463
464                     /* q is known to follow b and must be inserted before t.
465                     ** Increment b, so the range of possibilities is [b,t).
466                     ** Round binary split down, to favor early appearance.
467                     ** Adjust b and t until q belongs just before t.
468                     */
469
470                     b++;
471                     while (b < t) {
472                         p = PINDEX(b, (PNELEM(b, t) - 1) / 2);
473                         if (cmp(aTHX_ *q, *p) <= sense) {
474                             t = p;
475                         } else b = p + 1;
476                     }
477
478
479                     /* Copy all the strictly low elements */
480
481                     if (q == f1) {
482                         FROMTOUPTO(f2, tp2, t);
483                         *tp2++ = *f1++;
484                     } else {
485                         FROMTOUPTO(f1, tp2, t);
486                         *tp2++ = *f2++;
487                     }
488                 }
489
490
491                 /* Run out remaining list */
492                 if (f1 == l1) {
493                        if (f2 < l2) FROMTOUPTO(f2, tp2, l2);
494                 } else              FROMTOUPTO(f1, tp2, l1);
495                 p1 = NEXT(p1) = POTHER(tp2, list2, list1);
496
497                 if (--level == 0) goto done;
498                 --stackp;
499                 t = list1; list1 = list2; list2 = t;    /* swap lists */
500             } while ((runs = stackp->runs) == 0);
501         }
502
503
504         stackp->runs = 0;               /* current run will finish level */
505         /* While there are more than 2 runs remaining,
506          * turn them into exactly 2 runs (at the "other" level),
507          * each made up of approximately half the runs.
508          * Stack the second half for later processing,
509          * and set about producing the first half now.
510          */
511         while (runs > 2) {
512             ++level;
513             ++stackp;
514             stackp->offset = offset;
515             runs -= stackp->runs = runs / 2;
516         }
517         /* We must construct a single run from 1 or 2 runs.
518          * All the original runs are in which[0] == base.
519          * The run we construct must end up in which[level&1].
520          */
521         iwhich = level & 1;
522         if (runs == 1) {
523             /* Constructing a single run from a single run.
524              * If it's where it belongs already, there's nothing to do.
525              * Otherwise, copy it to where it belongs.
526              * A run of 1 is either a singleton at level 0,
527              * or the second half of a split 3.  In neither event
528              * is it necessary to set offset.  It will be set by the merge
529              * that immediately follows.
530              */
531             if (iwhich) {       /* Belongs in aux, currently in base */
532                 f1 = b = PINDEX(base, offset);  /* where list starts */
533                 f2 = PINDEX(aux, offset);       /* where list goes */
534                 t = NEXT(f2);                   /* where list will end */
535                 offset = PNELEM(aux, t);        /* offset thereof */
536                 t = PINDEX(base, offset);       /* where it currently ends */
537                 FROMTOUPTO(f1, f2, t);          /* copy */
538                 NEXT(b) = t;                    /* set up parallel pointer */
539             } else if (level == 0) goto done;   /* single run at level 0 */
540         } else {
541             /* Constructing a single run from two runs.
542              * The merge code at the top will do that.
543              * We need only make sure the two runs are in the "other" array,
544              * so they'll end up in the correct array after the merge.
545              */
546             ++level;
547             ++stackp;
548             stackp->offset = offset;
549             stackp->runs = 0;   /* take care of both runs, trigger merge */
550             if (!iwhich) {      /* Merged runs belong in aux, copy 1st */
551                 f1 = b = PINDEX(base, offset);  /* where first run starts */
552                 f2 = PINDEX(aux, offset);       /* where it will be copied */
553                 t = NEXT(f2);                   /* where first run will end */
554                 offset = PNELEM(aux, t);        /* offset thereof */
555                 p = PINDEX(base, offset);       /* end of first run */
556                 t = NEXT(t);                    /* where second run will end */
557                 t = PINDEX(base, PNELEM(aux, t)); /* where it now ends */
558                 FROMTOUPTO(f1, f2, t);          /* copy both runs */
559                 NEXT(b) = p;                    /* paralleled pointer for 1st */
560                 NEXT(p) = t;                    /* ... and for second */
561             }
562         }
563     }
564   done:
565     if (aux != small) Safefree(aux);    /* free iff allocated */
566     if (savecmp != NULL) {
567          PL_sort_RealCmp = savecmp;     /* Restore current comparison routine, if any */
568     }
569     return;
570 }
571
572 /*
573  * The quicksort implementation was derived from source code contributed
574  * by Tom Horsley.
575  *
576  * NOTE: this code was derived from Tom Horsley's qsort replacement
577  * and should not be confused with the original code.
578  */
579
580 /* Copyright (C) Tom Horsley, 1997. All rights reserved.
581
582    Permission granted to distribute under the same terms as perl which are
583    (briefly):
584
585     This program is free software; you can redistribute it and/or modify
586     it under the terms of either:
587
588         a) the GNU General Public License as published by the Free
589         Software Foundation; either version 1, or (at your option) any
590         later version, or
591
592         b) the "Artistic License" which comes with this Kit.
593
594    Details on the perl license can be found in the perl source code which
595    may be located via the www.perl.com web page.
596
597    This is the most wonderfulest possible qsort I can come up with (and
598    still be mostly portable) My (limited) tests indicate it consistently
599    does about 20% fewer calls to compare than does the qsort in the Visual
600    C++ library, other vendors may vary.
601
602    Some of the ideas in here can be found in "Algorithms" by Sedgewick,
603    others I invented myself (or more likely re-invented since they seemed
604    pretty obvious once I watched the algorithm operate for a while).
605
606    Most of this code was written while watching the Marlins sweep the Giants
607    in the 1997 National League Playoffs - no Braves fans allowed to use this
608    code (just kidding :-).
609
610    I realize that if I wanted to be true to the perl tradition, the only
611    comment in this file would be something like:
612
613    ...they shuffled back towards the rear of the line. 'No, not at the
614    rear!'  the slave-driver shouted. 'Three files up. And stay there...
615
616    However, I really needed to violate that tradition just so I could keep
617    track of what happens myself, not to mention some poor fool trying to
618    understand this years from now :-).
619 */
620
621 /* ********************************************************** Configuration */
622
623 #ifndef QSORT_ORDER_GUESS
624 #define QSORT_ORDER_GUESS 2     /* Select doubling version of the netBSD trick */
625 #endif
626
627 /* QSORT_MAX_STACK is the largest number of partitions that can be stacked up for
628    future processing - a good max upper bound is log base 2 of memory size
629    (32 on 32 bit machines, 64 on 64 bit machines, etc). In reality can
630    safely be smaller than that since the program is taking up some space and
631    most operating systems only let you grab some subset of contiguous
632    memory (not to mention that you are normally sorting data larger than
633    1 byte element size :-).
634 */
635 #ifndef QSORT_MAX_STACK
636 #define QSORT_MAX_STACK 32
637 #endif
638
639 /* QSORT_BREAK_EVEN is the size of the largest partition we should insertion sort.
640    Anything bigger and we use qsort. If you make this too small, the qsort
641    will probably break (or become less efficient), because it doesn't expect
642    the middle element of a partition to be the same as the right or left -
643    you have been warned).
644 */
645 #ifndef QSORT_BREAK_EVEN
646 #define QSORT_BREAK_EVEN 6
647 #endif
648
649 /* QSORT_PLAY_SAFE is the size of the largest partition we're willing
650    to go quadratic on.  We innoculate larger partitions against
651    quadratic behavior by shuffling them before sorting.  This is not
652    an absolute guarantee of non-quadratic behavior, but it would take
653    staggeringly bad luck to pick extreme elements as the pivot
654    from randomized data.
655 */
656 #ifndef QSORT_PLAY_SAFE
657 #define QSORT_PLAY_SAFE 255
658 #endif
659
660 /* ************************************************************* Data Types */
661
662 /* hold left and right index values of a partition waiting to be sorted (the
663    partition includes both left and right - right is NOT one past the end or
664    anything like that).
665 */
666 struct partition_stack_entry {
667    int left;
668    int right;
669 #ifdef QSORT_ORDER_GUESS
670    int qsort_break_even;
671 #endif
672 };
673
674 /* ******************************************************* Shorthand Macros */
675
676 /* Note that these macros will be used from inside the qsort function where
677    we happen to know that the variable 'elt_size' contains the size of an
678    array element and the variable 'temp' points to enough space to hold a
679    temp element and the variable 'array' points to the array being sorted
680    and 'compare' is the pointer to the compare routine.
681
682    Also note that there are very many highly architecture specific ways
683    these might be sped up, but this is simply the most generally portable
684    code I could think of.
685 */
686
687 /* Return < 0 == 0 or > 0 as the value of elt1 is < elt2, == elt2, > elt2
688 */
689 #define qsort_cmp(elt1, elt2) \
690    ((*compare)(aTHX_ array[elt1], array[elt2]))
691
692 #ifdef QSORT_ORDER_GUESS
693 #define QSORT_NOTICE_SWAP swapped++;
694 #else
695 #define QSORT_NOTICE_SWAP
696 #endif
697
698 /* swaps contents of array elements elt1, elt2.
699 */
700 #define qsort_swap(elt1, elt2) \
701    STMT_START { \
702       QSORT_NOTICE_SWAP \
703       temp = array[elt1]; \
704       array[elt1] = array[elt2]; \
705       array[elt2] = temp; \
706    } STMT_END
707
708 /* rotate contents of elt1, elt2, elt3 such that elt1 gets elt2, elt2 gets
709    elt3 and elt3 gets elt1.
710 */
711 #define qsort_rotate(elt1, elt2, elt3) \
712    STMT_START { \
713       QSORT_NOTICE_SWAP \
714       temp = array[elt1]; \
715       array[elt1] = array[elt2]; \
716       array[elt2] = array[elt3]; \
717       array[elt3] = temp; \
718    } STMT_END
719
720 /* ************************************************************ Debug stuff */
721
722 #ifdef QSORT_DEBUG
723
724 static void
725 break_here()
726 {
727    return; /* good place to set a breakpoint */
728 }
729
730 #define qsort_assert(t) (void)( (t) || (break_here(), 0) )
731
732 static void
733 doqsort_all_asserts(
734    void * array,
735    size_t num_elts,
736    size_t elt_size,
737    int (*compare)(const void * elt1, const void * elt2),
738    int pc_left, int pc_right, int u_left, int u_right)
739 {
740    int i;
741
742    qsort_assert(pc_left <= pc_right);
743    qsort_assert(u_right < pc_left);
744    qsort_assert(pc_right < u_left);
745    for (i = u_right + 1; i < pc_left; ++i) {
746       qsort_assert(qsort_cmp(i, pc_left) < 0);
747    }
748    for (i = pc_left; i < pc_right; ++i) {
749       qsort_assert(qsort_cmp(i, pc_right) == 0);
750    }
751    for (i = pc_right + 1; i < u_left; ++i) {
752       qsort_assert(qsort_cmp(pc_right, i) < 0);
753    }
754 }
755
756 #define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) \
757    doqsort_all_asserts(array, num_elts, elt_size, compare, \
758                  PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT)
759
760 #else
761
762 #define qsort_assert(t) ((void)0)
763
764 #define qsort_all_asserts(PC_LEFT, PC_RIGHT, U_LEFT, U_RIGHT) ((void)0)
765
766 #endif
767
768 /*
769 =head1 Array Manipulation Functions
770
771 =for apidoc sortsv
772
773 In-place sort an array of SV pointers with the given comparison routine.
774
775 Currently this always uses mergesort.  See C<L</sortsv_flags>> for a more
776 flexible routine.
777
778 =cut
779 */
780
781 void
782 Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
783 {
784     PERL_ARGS_ASSERT_SORTSV;
785
786     sortsv_flags(array, nmemb, cmp, 0);
787 }
788
789 #define SvNSIOK(sv) ((SvFLAGS(sv) & SVf_NOK) || ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK))
790 #define SvSIOK(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK)
791 #define SvNSIV(sv) ( SvNOK(sv) ? SvNVX(sv) : ( SvSIOK(sv) ? SvIVX(sv) : sv_2nv(sv) ) )
792
793 PP(pp_sort)
794 {
795     dSP; dMARK; dORIGMARK;
796     SV **p1 = ORIGMARK+1, **p2;
797     SSize_t max, i;
798     AV* av = NULL;
799     GV *gv;
800     CV *cv = NULL;
801     U8 gimme = GIMME_V;
802     OP* const nextop = PL_op->op_next;
803     I32 overloading = 0;
804     bool hasargs = FALSE;
805     bool copytmps;
806     I32 is_xsub = 0;
807     const U8 priv = PL_op->op_private;
808     const U8 flags = PL_op->op_flags;
809     U32 sort_flags = 0;
810     void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
811       = Perl_sortsv_flags;
812     I32 all_SIVs = 1;
813
814     if ((priv & OPpSORT_DESCEND) != 0)
815         sort_flags |= SORTf_DESC;
816     if ((priv & OPpSORT_STABLE) != 0)
817         sort_flags |= SORTf_STABLE;
818     if ((priv & OPpSORT_UNSTABLE) != 0)
819         sort_flags |= SORTf_UNSTABLE;
820
821     if (gimme != G_ARRAY) {
822         SP = MARK;
823         EXTEND(SP,1);
824         RETPUSHUNDEF;
825     }
826
827     ENTER;
828     SAVEVPTR(PL_sortcop);
829     if (flags & OPf_STACKED) {
830         if (flags & OPf_SPECIAL) {
831             OP *nullop = OpSIBLING(cLISTOP->op_first);  /* pass pushmark */
832             assert(nullop->op_type == OP_NULL);
833             PL_sortcop = nullop->op_next;
834         }
835         else {
836             GV *autogv = NULL;
837             HV *stash;
838             cv = sv_2cv(*++MARK, &stash, &gv, GV_ADD);
839           check_cv:
840             if (cv && SvPOK(cv)) {
841                 const char * const proto = SvPV_nolen_const(MUTABLE_SV(cv));
842                 if (proto && strEQ(proto, "$$")) {
843                     hasargs = TRUE;
844                 }
845             }
846             if (cv && CvISXSUB(cv) && CvXSUB(cv)) {
847                 is_xsub = 1;
848             }
849             else if (!(cv && CvROOT(cv))) {
850                 if (gv) {
851                     goto autoload;
852                 }
853                 else if (!CvANON(cv) && (gv = CvGV(cv))) {
854                   if (cv != GvCV(gv)) cv = GvCV(gv);
855                  autoload:
856                   if (!autogv && (
857                         autogv = gv_autoload_pvn(
858                             GvSTASH(gv), GvNAME(gv), GvNAMELEN(gv),
859                             GvNAMEUTF8(gv) ? SVf_UTF8 : 0
860                         )
861                      )) {
862                     cv = GvCVu(autogv);
863                     goto check_cv;
864                   }
865                   else {
866                     SV *tmpstr = sv_newmortal();
867                     gv_efullname3(tmpstr, gv, NULL);
868                     DIE(aTHX_ "Undefined sort subroutine \"%" SVf "\" called",
869                         SVfARG(tmpstr));
870                   }
871                 }
872                 else {
873                     DIE(aTHX_ "Undefined subroutine in sort");
874                 }
875             }
876
877             if (is_xsub)
878                 PL_sortcop = (OP*)cv;
879             else
880                 PL_sortcop = CvSTART(cv);
881         }
882     }
883     else {
884         PL_sortcop = NULL;
885     }
886
887     /* optimiser converts "@a = sort @a" to "sort \@a".  In this case,
888      * push (@a) onto stack, then assign result back to @a at the end of
889      * this function */
890     if (priv & OPpSORT_INPLACE) {
891         assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV);
892         (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */
893         av = MUTABLE_AV((*SP));
894         if (SvREADONLY(av))
895             Perl_croak_no_modify();
896         max = AvFILL(av) + 1;
897         MEXTEND(SP, max);
898         if (SvMAGICAL(av)) {
899             for (i=0; i < max; i++) {
900                 SV **svp = av_fetch(av, i, FALSE);
901                 *SP++ = (svp) ? *svp : NULL;
902             }
903         }
904         else {
905             SV **svp = AvARRAY(av);
906             assert(svp || max == 0);
907             for (i = 0; i < max; i++)
908                 *SP++ = *svp++;
909         }
910         SP--;
911         p1 = p2 = SP - (max-1);
912     }
913     else {
914         p2 = MARK+1;
915         max = SP - MARK;
916    }
917
918     /* shuffle stack down, removing optional initial cv (p1!=p2), plus
919      * any nulls; also stringify or converting to integer or number as
920      * required any args */
921     copytmps = cBOOL(PL_sortcop);
922     for (i=max; i > 0 ; i--) {
923         if ((*p1 = *p2++)) {                    /* Weed out nulls. */
924             if (copytmps && SvPADTMP(*p1)) {
925                 *p1 = sv_mortalcopy(*p1);
926             }
927             SvTEMP_off(*p1);
928             if (!PL_sortcop) {
929                 if (priv & OPpSORT_NUMERIC) {
930                     if (priv & OPpSORT_INTEGER) {
931                         if (!SvIOK(*p1))
932                             (void)sv_2iv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
933                     }
934                     else {
935                         if (!SvNSIOK(*p1))
936                             (void)sv_2nv_flags(*p1, SV_GMAGIC|SV_SKIP_OVERLOAD);
937                         if (all_SIVs && !SvSIOK(*p1))
938                             all_SIVs = 0;
939                     }
940                 }
941                 else {
942                     if (!SvPOK(*p1))
943                         (void)sv_2pv_flags(*p1, 0,
944                             SV_GMAGIC|SV_CONST_RETURN|SV_SKIP_OVERLOAD);
945                 }
946                 if (SvAMAGIC(*p1))
947                     overloading = 1;
948             }
949             p1++;
950         }
951         else
952             max--;
953     }
954     if (max > 1) {
955         SV **start;
956         if (PL_sortcop) {
957             PERL_CONTEXT *cx;
958             const bool oldcatch = CATCH_GET;
959             I32 old_savestack_ix = PL_savestack_ix;
960
961             SAVEOP();
962
963             CATCH_SET(TRUE);
964             PUSHSTACKi(PERLSI_SORT);
965             if (!hasargs && !is_xsub) {
966                 SAVEGENERICSV(PL_firstgv);
967                 SAVEGENERICSV(PL_secondgv);
968                 PL_firstgv = MUTABLE_GV(SvREFCNT_inc(
969                     gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV)
970                 ));
971                 PL_secondgv = MUTABLE_GV(SvREFCNT_inc(
972                     gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV)
973                 ));
974                 /* make sure the GP isn't removed out from under us for
975                  * the SAVESPTR() */
976                 save_gp(PL_firstgv, 0);
977                 save_gp(PL_secondgv, 0);
978                 /* we don't want modifications localized */
979                 GvINTRO_off(PL_firstgv);
980                 GvINTRO_off(PL_secondgv);
981                 SAVEGENERICSV(GvSV(PL_firstgv));
982                 SvREFCNT_inc(GvSV(PL_firstgv));
983                 SAVEGENERICSV(GvSV(PL_secondgv));
984                 SvREFCNT_inc(GvSV(PL_secondgv));
985             }
986
987             gimme = G_SCALAR;
988             cx = cx_pushblock(CXt_NULL, gimme, PL_stack_base, old_savestack_ix);
989             if (!(flags & OPf_SPECIAL)) {
990                 cx->cx_type = CXt_SUB|CXp_MULTICALL;
991                 cx_pushsub(cx, cv, NULL, hasargs);
992                 if (!is_xsub) {
993                     PADLIST * const padlist = CvPADLIST(cv);
994
995                     if (++CvDEPTH(cv) >= 2)
996                         pad_push(padlist, CvDEPTH(cv));
997                     PAD_SET_CUR_NOSAVE(padlist, CvDEPTH(cv));
998
999                     if (hasargs) {
1000                         /* This is mostly copied from pp_entersub */
1001                         AV * const av = MUTABLE_AV(PAD_SVl(0));
1002
1003                         cx->blk_sub.savearray = GvAV(PL_defgv);
1004                         GvAV(PL_defgv) = MUTABLE_AV(SvREFCNT_inc_simple(av));
1005                     }
1006
1007                 }
1008             }
1009
1010             start = p1 - max;
1011             sortsvp(aTHX_ start, max,
1012                     (is_xsub ? S_sortcv_xsub : hasargs ? S_sortcv_stacked : S_sortcv),
1013                     sort_flags);
1014
1015             /* Reset cx, in case the context stack has been reallocated. */
1016             cx = CX_CUR();
1017
1018             PL_stack_sp = PL_stack_base + cx->blk_oldsp;
1019
1020             CX_LEAVE_SCOPE(cx);
1021             if (!(flags & OPf_SPECIAL)) {
1022                 assert(CxTYPE(cx) == CXt_SUB);
1023                 cx_popsub(cx);
1024             }
1025             else
1026                 assert(CxTYPE(cx) == CXt_NULL);
1027                 /* there isn't a POPNULL ! */
1028
1029             cx_popblock(cx);
1030             CX_POP(cx);
1031             POPSTACK;
1032             CATCH_SET(oldcatch);
1033         }
1034         else {
1035             MEXTEND(SP, 20);    /* Can't afford stack realloc on signal. */
1036             start = ORIGMARK+1;
1037             sortsvp(aTHX_ start, max,
1038                     (priv & OPpSORT_NUMERIC)
1039                         ? ( ( ( priv & OPpSORT_INTEGER) || all_SIVs)
1040                             ? ( overloading ? S_amagic_i_ncmp : S_sv_i_ncmp)
1041                             : ( overloading ? S_amagic_ncmp : S_sv_ncmp ) )
1042                         : (
1043 #ifdef USE_LOCALE_COLLATE
1044                            IN_LC_RUNTIME(LC_COLLATE)
1045                             ? ( overloading
1046                                 ? (SVCOMPARE_t)S_amagic_cmp_locale
1047                                 : (SVCOMPARE_t)sv_cmp_locale_static)
1048                             :
1049 #endif
1050                               ( overloading ? (SVCOMPARE_t)S_amagic_cmp : (SVCOMPARE_t)sv_cmp_static)),
1051                     sort_flags);
1052         }
1053         if ((priv & OPpSORT_REVERSE) != 0) {
1054             SV **q = start+max-1;
1055             while (start < q) {
1056                 SV * const tmp = *start;
1057                 *start++ = *q;
1058                 *q-- = tmp;
1059             }
1060         }
1061     }
1062
1063     if (av) {
1064         /* copy back result to the array */
1065         SV** const base = MARK+1;
1066         if (SvMAGICAL(av)) {
1067             for (i = 0; i < max; i++)
1068                 base[i] = newSVsv(base[i]);
1069             av_clear(av);
1070             if (max)
1071                 av_extend(av, max-1);
1072             for (i=0; i < max; i++) {
1073                 SV * const sv = base[i];
1074                 SV ** const didstore = av_store(av, i, sv);
1075                 if (SvSMAGICAL(sv))
1076                     mg_set(sv);
1077                 if (!didstore)
1078                     sv_2mortal(sv);
1079             }
1080         }
1081         else {
1082             /* the elements of av are likely to be the same as the
1083              * (non-refcounted) elements on the stack, just in a different
1084              * order. However, its possible that someone's messed with av
1085              * in the meantime. So bump and unbump the relevant refcounts
1086              * first.
1087              */
1088             for (i = 0; i < max; i++) {
1089                 SV *sv = base[i];
1090                 assert(sv);
1091                 if (SvREFCNT(sv) > 1)
1092                     base[i] = newSVsv(sv);
1093                 else
1094                     SvREFCNT_inc_simple_void_NN(sv);
1095             }
1096             av_clear(av);
1097             if (max > 0) {
1098                 av_extend(av, max-1);
1099                 Copy(base, AvARRAY(av), max, SV*);
1100             }
1101             AvFILLp(av) = max - 1;
1102             AvREIFY_off(av);
1103             AvREAL_on(av);
1104         }
1105     }
1106     LEAVE;
1107     PL_stack_sp = ORIGMARK +  max;
1108     return nextop;
1109 }
1110
1111 static I32
1112 S_sortcv(pTHX_ SV *const a, SV *const b)
1113 {
1114     const I32 oldsaveix = PL_savestack_ix;
1115     I32 result;
1116     PMOP * const pm = PL_curpm;
1117     COP * const cop = PL_curcop;
1118     SV *olda, *oldb;
1119  
1120     PERL_ARGS_ASSERT_SORTCV;
1121
1122     olda = GvSV(PL_firstgv);
1123     GvSV(PL_firstgv) = SvREFCNT_inc_simple_NN(a);
1124     SvREFCNT_dec(olda);
1125     oldb = GvSV(PL_secondgv);
1126     GvSV(PL_secondgv) = SvREFCNT_inc_simple_NN(b);
1127     SvREFCNT_dec(oldb);
1128     PL_stack_sp = PL_stack_base;
1129     PL_op = PL_sortcop;
1130     CALLRUNOPS(aTHX);
1131     PL_curcop = cop;
1132     /* entry zero of a stack is always PL_sv_undef, which
1133      * simplifies converting a '()' return into undef in scalar context */
1134     assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
1135     result = SvIV(*PL_stack_sp);
1136
1137     LEAVE_SCOPE(oldsaveix);
1138     PL_curpm = pm;
1139     return result;
1140 }
1141
1142 static I32
1143 S_sortcv_stacked(pTHX_ SV *const a, SV *const b)
1144 {
1145     const I32 oldsaveix = PL_savestack_ix;
1146     I32 result;
1147     AV * const av = GvAV(PL_defgv);
1148     PMOP * const pm = PL_curpm;
1149     COP * const cop = PL_curcop;
1150
1151     PERL_ARGS_ASSERT_SORTCV_STACKED;
1152
1153     if (AvREAL(av)) {
1154         av_clear(av);
1155         AvREAL_off(av);
1156         AvREIFY_on(av);
1157     }
1158     if (AvMAX(av) < 1) {
1159         SV **ary = AvALLOC(av);
1160         if (AvARRAY(av) != ary) {
1161             AvMAX(av) += AvARRAY(av) - AvALLOC(av);
1162             AvARRAY(av) = ary;
1163         }
1164         if (AvMAX(av) < 1) {
1165             Renew(ary,2,SV*);
1166             AvMAX(av) = 1;
1167             AvARRAY(av) = ary;
1168             AvALLOC(av) = ary;
1169         }
1170     }
1171     AvFILLp(av) = 1;
1172
1173     AvARRAY(av)[0] = a;
1174     AvARRAY(av)[1] = b;
1175     PL_stack_sp = PL_stack_base;
1176     PL_op = PL_sortcop;
1177     CALLRUNOPS(aTHX);
1178     PL_curcop = cop;
1179     /* entry zero of a stack is always PL_sv_undef, which
1180      * simplifies converting a '()' return into undef in scalar context */
1181     assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
1182     result = SvIV(*PL_stack_sp);
1183
1184     LEAVE_SCOPE(oldsaveix);
1185     PL_curpm = pm;
1186     return result;
1187 }
1188
1189 static I32
1190 S_sortcv_xsub(pTHX_ SV *const a, SV *const b)
1191 {
1192     dSP;
1193     const I32 oldsaveix = PL_savestack_ix;
1194     CV * const cv=MUTABLE_CV(PL_sortcop);
1195     I32 result;
1196     PMOP * const pm = PL_curpm;
1197
1198     PERL_ARGS_ASSERT_SORTCV_XSUB;
1199
1200     SP = PL_stack_base;
1201     PUSHMARK(SP);
1202     EXTEND(SP, 2);
1203     *++SP = a;
1204     *++SP = b;
1205     PUTBACK;
1206     (void)(*CvXSUB(cv))(aTHX_ cv);
1207     /* entry zero of a stack is always PL_sv_undef, which
1208      * simplifies converting a '()' return into undef in scalar context */
1209     assert(PL_stack_sp > PL_stack_base || *PL_stack_base == &PL_sv_undef);
1210     result = SvIV(*PL_stack_sp);
1211
1212     LEAVE_SCOPE(oldsaveix);
1213     PL_curpm = pm;
1214     return result;
1215 }
1216
1217
1218 static I32
1219 S_sv_ncmp(pTHX_ SV *const a, SV *const b)
1220 {
1221     I32 cmp = do_ncmp(a, b);
1222
1223     PERL_ARGS_ASSERT_SV_NCMP;
1224
1225     if (cmp == 2) {
1226         if (ckWARN(WARN_UNINITIALIZED)) report_uninit(NULL);
1227         return 0;
1228     }
1229
1230     return cmp;
1231 }
1232
1233 static I32
1234 S_sv_i_ncmp(pTHX_ SV *const a, SV *const b)
1235 {
1236     const IV iv1 = SvIV(a);
1237     const IV iv2 = SvIV(b);
1238
1239     PERL_ARGS_ASSERT_SV_I_NCMP;
1240
1241     return iv1 < iv2 ? -1 : iv1 > iv2 ? 1 : 0;
1242 }
1243
1244 #define tryCALL_AMAGICbin(left,right,meth) \
1245     (SvAMAGIC(left)||SvAMAGIC(right)) \
1246         ? amagic_call(left, right, meth, 0) \
1247         : NULL;
1248
1249 #define SORT_NORMAL_RETURN_VALUE(val)  (((val) > 0) ? 1 : ((val) ? -1 : 0))
1250
1251 static I32
1252 S_amagic_ncmp(pTHX_ SV *const a, SV *const b)
1253 {
1254     SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
1255
1256     PERL_ARGS_ASSERT_AMAGIC_NCMP;
1257
1258     if (tmpsv) {
1259         if (SvIOK(tmpsv)) {
1260             const I32 i = SvIVX(tmpsv);
1261             return SORT_NORMAL_RETURN_VALUE(i);
1262         }
1263         else {
1264             const NV d = SvNV(tmpsv);
1265             return SORT_NORMAL_RETURN_VALUE(d);
1266         }
1267      }
1268      return S_sv_ncmp(aTHX_ a, b);
1269 }
1270
1271 static I32
1272 S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b)
1273 {
1274     SV * const tmpsv = tryCALL_AMAGICbin(a,b,ncmp_amg);
1275
1276     PERL_ARGS_ASSERT_AMAGIC_I_NCMP;
1277
1278     if (tmpsv) {
1279         if (SvIOK(tmpsv)) {
1280             const I32 i = SvIVX(tmpsv);
1281             return SORT_NORMAL_RETURN_VALUE(i);
1282         }
1283         else {
1284             const NV d = SvNV(tmpsv);
1285             return SORT_NORMAL_RETURN_VALUE(d);
1286         }
1287     }
1288     return S_sv_i_ncmp(aTHX_ a, b);
1289 }
1290
1291 static I32
1292 S_amagic_cmp(pTHX_ SV *const str1, SV *const str2)
1293 {
1294     SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
1295
1296     PERL_ARGS_ASSERT_AMAGIC_CMP;
1297
1298     if (tmpsv) {
1299         if (SvIOK(tmpsv)) {
1300             const I32 i = SvIVX(tmpsv);
1301             return SORT_NORMAL_RETURN_VALUE(i);
1302         }
1303         else {
1304             const NV d = SvNV(tmpsv);
1305             return SORT_NORMAL_RETURN_VALUE(d);
1306         }
1307     }
1308     return sv_cmp(str1, str2);
1309 }
1310
1311 #ifdef USE_LOCALE_COLLATE
1312
1313 static I32
1314 S_amagic_cmp_locale(pTHX_ SV *const str1, SV *const str2)
1315 {
1316     SV * const tmpsv = tryCALL_AMAGICbin(str1,str2,scmp_amg);
1317
1318     PERL_ARGS_ASSERT_AMAGIC_CMP_LOCALE;
1319
1320     if (tmpsv) {
1321         if (SvIOK(tmpsv)) {
1322             const I32 i = SvIVX(tmpsv);
1323             return SORT_NORMAL_RETURN_VALUE(i);
1324         }
1325         else {
1326             const NV d = SvNV(tmpsv);
1327             return SORT_NORMAL_RETURN_VALUE(d);
1328         }
1329     }
1330     return sv_cmp_locale(str1, str2);
1331 }
1332
1333 #endif
1334
1335 /*
1336  * ex: set ts=8 sts=4 sw=4 et:
1337  */