From: John P. Linderman Date: Mon, 17 Dec 2001 07:11:27 +0000 (-0500) Subject: Re: perl@13661 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3fe0b9a92b23bfc87b2e318dbb8d3f5cd834b8b4;p=p5sagit%2Fp5-mst-13.2.git Re: perl@13661 Message-Id: <200112171211.HAA71597@raptor.research.att.com> p4raw-id: //depot/perl@13727 --- diff --git a/pp_sort.c b/pp_sort.c index fa76c3e..e758984 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -245,164 +245,9 @@ dynprep(pTHX_ gptr *list1, gptr *list2, size_t nmemb, SVCOMPARE_t cmp) } -/* 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. -*/ - -STATIC void -S_mergesortsv(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; - gptr small[SMALLSORT]; - - if (nmemb <= 1) return; /* sorted trivially */ - if (nmemb <= SMALLSORT) list2 = small; /* use stack for aux array */ - else { 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); - } - if (aux != small) Safefree(aux); /* free iff allocated */ - return; -} - - -/* What perl needs (least) is another sort implementation in the core. - * So what's the story? The short (by jpl's standards) story is that - * the merge sort above, in use since 5.7, is as fast as, or faster than, +/* The original merge sort, in use since 5.7, was as fast as, or faster than, * qsort on many platforms, but slower than qsort, conspicuously so, - * on others. The most likely explanation is platform-specific + * on others. The most likely explanation was platform-specific * differences in cache sizes and relative speeds. * * The quicksort divide-and-conquer algorithm guarantees that, as the @@ -411,7 +256,7 @@ S_mergesortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) * many levels of cache exist, quicksort will "find" them, and, * as long as smaller is faster, take advanatge of them. * - * By contrast, consider how the quicksort algorithm above works. + * By contrast, consider how the original mergesort algorithm worked. * Suppose we have five runs (each typically of length 2 after dynprep). * * pass base aux @@ -478,9 +323,6 @@ S_mergesortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) * The actual cache-friendly implementation will use a pseudo-stack * to avoid recursion, and will unroll processing of runs of length 2, * but it is otherwise similar to the recursive implementation. - * If it's as good as the original mergesort implementation on all - * platforms, it should replace that implementation. For benchmarking, - * though, it is convenient to have both implementations available. */ typedef struct { @@ -489,7 +331,7 @@ typedef struct { } off_runs; /* pseudo-stack element */ STATIC void -S_cfmergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp) +S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp) { IV i, run, runs, offset; I32 sense, level; @@ -1548,7 +1390,7 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) sortsvp = S_qsortsv; else { if (hints & HINT_SORT_MERGESORT) - sortsvp = S_cfmergesortsv; + sortsvp = S_mergesortsv; else sortsvp = S_mergesortsv; }