rip out quicksort and sort algorithm control
authorZefram <zefram@fysh.org>
Fri, 17 Nov 2017 05:28:21 +0000 (05:28 +0000)
committerZefram <zefram@fysh.org>
Fri, 17 Nov 2017 05:33:04 +0000 (05:33 +0000)
[perl #119635]

16 files changed:
embed.fnc
embed.h
ext/B/t/f_sort
ext/B/t/f_sort.t
lib/B/Op_private.pm
lib/sort.pm
lib/sort.t
op.c
opcode.h
perl.h
pod/perldelta.pod
pod/perlfunc.pod
pod/perlsec.pod
pp_sort.c
proto.h
regen/op_private

index 52bb848..c33833a 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2270,7 +2270,6 @@ s |I32    |amagic_cmp_locale|NN SV *const str1|NN SV *const str2
 s      |I32    |sortcv         |NN SV *const a|NN SV *const b
 s      |I32    |sortcv_xsub    |NN SV *const a|NN SV *const b
 s      |I32    |sortcv_stacked |NN SV *const a|NN SV *const b
-s      |void   |qsortsvu       |NULLOK SV** array|size_t num_elts|NN SVCOMPARE_t compare
 #endif
 
 #if defined(PERL_IN_PP_SYS_C)
diff --git a/embed.h b/embed.h
index 2c047fb..13277fc 100644 (file)
--- a/embed.h
+++ b/embed.h
 #define amagic_cmp(a,b)                S_amagic_cmp(aTHX_ a,b)
 #define amagic_i_ncmp(a,b)     S_amagic_i_ncmp(aTHX_ a,b)
 #define amagic_ncmp(a,b)       S_amagic_ncmp(aTHX_ a,b)
-#define qsortsvu(a,b,c)                S_qsortsvu(aTHX_ a,b,c)
 #define sortcv(a,b)            S_sortcv(aTHX_ a,b)
 #define sortcv_stacked(a,b)    S_sortcv_stacked(aTHX_ a,b)
 #define sortcv_xsub(a,b)       S_sortcv_xsub(aTHX_ a,b)
index 759523b..75e8f10 100644 (file)
@@ -68,10 +68,6 @@ sub other::backwards ($$) { $_[1] cmp $_[0]; }
 use sort 'stable';
 @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 
-# force use of mergesort (not portable outside Perl 5.8)
-use sort '_mergesort';
-@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
-
 # you should have a good reason to do this!
 @articles = sort {$FooPack::b <=> $FooPack::a} @files;
 
index ccee813..24a9f2e 100644 (file)
@@ -13,7 +13,7 @@ BEGIN {
     }
 }
 use OptreeCheck;
-plan tests => 40;
+plan tests => 38;
 
 =head1 f_sort.t
 
@@ -679,44 +679,6 @@ checkOptree(note   => q{},
            code   => q{use sort 'stable'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
            expect => $expect, expect_nt => $expect_nt);
 
-=for gentest
-
-# chunk: # force use of mergesort (not portable outside Perl 5.8)
-use sort '_mergesort';
-@new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
-
-=cut
-
-checkOptree(note   => q{},
-           bcopts => q{-exec},
-           code   => q{use sort '_mergesort'; @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old; },
-           expect => <<'EOT_EOT', expect_nt => <<'EONT_EONT');
-# 1  <;> nextstate(main 662 (eval 42):1) v:%,{
-# 2  <0> pushmark s
-# 3  <0> pushmark s
-# 4  <#> gv[*old] s
-# 5  <1> rv2av[t9] lKM/1
-# 6  <@> sort lKS*
-# 7  <0> pushmark s
-# 8  <#> gv[*new] s
-# 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t14] KS/COM_AGG
-# b  <1> leavesub[1 ref] K/REFC,1
-EOT_EOT
-# 1  <;> nextstate(main 578 (eval 15):1) v:%,{
-# 2  <0> pushmark s
-# 3  <0> pushmark s
-# 4  <$> gv(*old) s
-# 5  <1> rv2av[t5] lKM/1
-# 6  <@> sort lKS*
-# 7  <0> pushmark s
-# 8  <$> gv(*new) s
-# 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t6] KS/COM_AGG
-# b  <1> leavesub[1 ref] K/REFC,1
-EONT_EONT
-    
-
 =for gentest
 
 # chunk: # you should have a good reason to do this!
index 6c9840e..aaac03a 100644 (file)
@@ -538,7 +538,7 @@ $bits{sin}{0} = $bf[0];
 $bits{snetent}{0} = $bf[0];
 @{$bits{socket}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{sockpair}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
-@{$bits{sort}}{7,6,5,4,3,2,1,0} = ('OPpSORT_UNSTABLE', 'OPpSORT_STABLE', 'OPpSORT_QSORT', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC');
+@{$bits{sort}}{7,6,4,3,2,1,0} = ('OPpSORT_UNSTABLE', 'OPpSORT_STABLE', 'OPpSORT_DESCEND', 'OPpSORT_INPLACE', 'OPpSORT_REVERSE', 'OPpSORT_INTEGER', 'OPpSORT_NUMERIC');
 @{$bits{splice}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
 @{$bits{split}}{4,3,2} = ('OPpSPLIT_ASSIGN', 'OPpSPLIT_LEX', 'OPpSPLIT_IMPLIM');
 @{$bits{sprintf}}{3,2,1,0} = ($bf[4], $bf[4], $bf[4], $bf[4]);
@@ -677,7 +677,6 @@ our %defines = (
     OPpSORT_INPLACE          =>   8,
     OPpSORT_INTEGER          =>   2,
     OPpSORT_NUMERIC          =>   1,
-    OPpSORT_QSORT            =>  32,
     OPpSORT_REVERSE          =>   4,
     OPpSORT_STABLE           =>  64,
     OPpSORT_UNSTABLE         => 128,
@@ -780,7 +779,6 @@ our %labels = (
     OPpSORT_INPLACE          => 'INPLACE',
     OPpSORT_INTEGER          => 'INT',
     OPpSORT_NUMERIC          => 'NUM',
-    OPpSORT_QSORT            => 'QSORT',
     OPpSORT_REVERSE          => 'REV',
     OPpSORT_STABLE           => 'STABLE',
     OPpSORT_UNSTABLE         => 'UNSTABLE',
@@ -881,7 +879,6 @@ $ops_using{OPpSLICE} = $ops_using{OPpKVSLICE};
 $ops_using{OPpSORT_INPLACE} = $ops_using{OPpSORT_DESCEND};
 $ops_using{OPpSORT_INTEGER} = $ops_using{OPpSORT_DESCEND};
 $ops_using{OPpSORT_NUMERIC} = $ops_using{OPpSORT_DESCEND};
-$ops_using{OPpSORT_QSORT} = $ops_using{OPpSORT_DESCEND};
 $ops_using{OPpSORT_REVERSE} = $ops_using{OPpSORT_DESCEND};
 $ops_using{OPpSORT_STABLE} = $ops_using{OPpSORT_DESCEND};
 $ops_using{OPpSORT_UNSTABLE} = $ops_using{OPpSORT_DESCEND};
index 99d9f0b..659f3e4 100644 (file)
@@ -1,13 +1,10 @@
 package sort;
 
-our $VERSION = '2.03';
+our $VERSION = '2.04';
 
 # The hints for pp_sort are now stored in $^H{sort}; older versions
 # of perl used the global variable $sort::hints. -- rjh 2005-12-19
 
-$sort::quicksort_bit   = 0x00000001;
-$sort::mergesort_bit   = 0x00000002;
-$sort::sort_bits       = 0x000000FF; # allow 256 different ones
 $sort::stable_bit      = 0x00000100;
 $sort::unstable_bit    = 0x00000200;
 
@@ -22,13 +19,7 @@ sub import {
     local $_;
     $^H{sort} //= 0;
     while ($_ = shift(@_)) {
-       if (/^_q(?:uick)?sort$/) {
-           $^H{sort} &= ~$sort::sort_bits;
-           $^H{sort} |=  $sort::quicksort_bit;
-       } elsif ($_ eq '_mergesort') {
-           $^H{sort} &= ~$sort::sort_bits;
-           $^H{sort} |=  $sort::mergesort_bit;
-       } elsif ($_ eq 'stable') {
+       if ($_ eq 'stable') {
            $^H{sort} |=  $sort::stable_bit;
            $^H{sort} &= ~$sort::unstable_bit;
        } elsif ($_ eq 'defaults') {
@@ -49,11 +40,7 @@ sub unimport {
     local $_;
     no warnings 'uninitialized';       # bitops would warn
     while ($_ = shift(@_)) {
-       if (/^_q(?:uick)?sort$/) {
-           $^H{sort} &= ~$sort::sort_bits;
-       } elsif ($_ eq '_mergesort') {
-           $^H{sort} &= ~$sort::sort_bits;
-       } elsif ($_ eq 'stable') {
+       if ($_ eq 'stable') {
            $^H{sort} &= ~$sort::stable_bit;
            $^H{sort} |=  $sort::unstable_bit;
        } else {
@@ -66,11 +53,8 @@ sub unimport {
 sub current {
     my @sort;
     if ($^H{sort}) {
-       push @sort, 'quicksort' if $^H{sort} & $sort::quicksort_bit;
-       push @sort, 'mergesort' if $^H{sort} & $sort::mergesort_bit;
        push @sort, 'stable'    if $^H{sort} & $sort::stable_bit;
     }
-    push @sort, 'mergesort' unless @sort;
     join(' ', @sort);
 }
 
@@ -84,16 +68,12 @@ sort - perl pragma to control sort() behaviour
 =head1 SYNOPSIS
 
     use sort 'stable';         # guarantee stability
-    use sort '_quicksort';     # use a quicksort algorithm
-    use sort '_mergesort';     # use a mergesort algorithm
     use sort 'defaults';       # revert to default behavior
     no  sort 'stable';         # stability not important
 
-    use sort '_qsort';         # alias for quicksort
-
     my $current;
     BEGIN {
-       $current = sort::current();     # identify prevailing algorithm
+       $current = sort::current();     # identify prevailing pragmata
     }
 
 =head1 DESCRIPTION
@@ -101,15 +81,8 @@ sort - perl pragma to control sort() behaviour
 With the C<sort> pragma you can control the behaviour of the builtin
 C<sort()> function.
 
-In Perl versions 5.6 and earlier the quicksort algorithm was used to
-implement C<sort()>, but in Perl 5.8 a mergesort algorithm was also made
-available, mainly to guarantee worst case O(N log N) behaviour:
-the worst case of quicksort is O(N**2).  In Perl 5.8 and later,
-quicksort defends against quadratic behaviour by shuffling large
-arrays before sorting.
-
 A stable sort means that for records that compare equal, the original
-input ordering is preserved.  Mergesort is stable, quicksort is not.
+input ordering is preserved.
 Stability will matter only if elements that compare equal can be
 distinguished in some other way.  That means that simple numerical
 and lexical sorts do not profit from stability, since equal elements
@@ -119,22 +92,10 @@ are indistinguishable.  However, with a comparison such as
 
 stability might matter because elements that compare equal on the
 first 3 characters may be distinguished based on subsequent characters.
-In Perl 5.8 and later, quicksort can be stabilized, but doing so will
-add overhead, so it should only be done if it matters.
-
-The best algorithm depends on many things.  On average, mergesort
-does fewer comparisons than quicksort, so it may be better when
-complicated comparison routines are used.  Mergesort also takes
-advantage of pre-existing order, so it would be favored for using
-C<sort()> to merge several sorted arrays.  On the other hand, quicksort
-is often faster for small arrays, and on arrays of a few distinct
-values, repeated many times.  You can force the
-choice of algorithm with this pragma, but this feels heavy-handed,
-so the subpragmas beginning with a C<_> may not persist beyond Perl 5.8.
-The default algorithm is mergesort, which will be stable even if
-you do not explicitly demand it.
-But the stability of the default sort is a side-effect that could
-change in later versions.  If stability is important, be sure to
+
+Whether sorting is stable by default is an accident of implementation
+that can change (and has changed) between Perl versions.
+If stability is important, be sure to
 say so with a
 
   use sort 'stable';
@@ -142,15 +103,9 @@ say so with a
 The C<no sort> pragma doesn't
 I<forbid> what follows, it just leaves the choice open.  Thus, after
 
-  no sort qw(_mergesort stable);
-
-a mergesort, which happens to be stable, will be employed anyway.
-Note that
-
-  no sort "_quicksort";
-  no sort "_mergesort";
+  no sort 'stable';
 
-have exactly the same effect, leaving the choice of sort algorithm open.
+sorting may happen to be stable anyway.
 
 =head1 CAVEATS
 
@@ -159,8 +114,7 @@ at compile time. In earlier versions its effect was global and took
 effect at run-time; the documentation suggested using C<eval()> to
 change the behaviour:
 
-  { eval 'use sort qw(defaults _quicksort)'; # force quicksort
-    eval 'no sort "stable"';      # stability not wanted
+  { eval 'no sort "stable"';      # stability not wanted
     print sort::current . "\n";
     @a = sort @b;
     eval 'use sort "defaults"';   # clean up, for others
@@ -180,8 +134,7 @@ is the one that matters.
 
 So now this code would be written:
 
-  { use sort qw(defaults _quicksort); # force quicksort
-    no sort "stable";      # stability not wanted
+  { no sort "stable";      # stability not wanted
     my $current;
     BEGIN { $current = sort::current; }
     print "$current\n";
index 1ff3832..e0ef9d3 100644 (file)
@@ -26,10 +26,8 @@ use strict;
 use warnings;
 
 use Test::More tests => @TestSizes * 2 # sort() tests
-                       * 6             # number of pragmas to test
-                       + 1             # extra test for qsort instability
-                       + 3             # tests for sort::current
-                       + 3;            # tests for "defaults" and "no sort"
+                       * 3             # number of pragmas to test
+                       + 2;            # tests for sort::current
 
 # Generate array of specified size for testing sort.
 #
@@ -144,48 +142,19 @@ main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
        my @ignore = sort (5,4,3,2,1);
        return $a <=> $b;
     }
-    use sort qw( defaults _qsort stable );
+    use sort qw( defaults stable );
     my @nested = sort { dumbsort($a,$b) } (3,2,2,1);
 }
 
 {
-    use sort qw(_qsort);
+    use sort qw(stable);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
-    is($sort_current, 'quicksort', 'sort::current for _qsort');
-    main(sub { sort {&{$_[0]}} @{$_[1]} }, 1);
-}
-
-{
-    use sort qw(_mergesort);
-    my $sort_current; BEGIN { $sort_current = sort::current(); }
-    is($sort_current, 'mergesort', 'sort::current for _mergesort');
-    main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
-}
-
-{
-    use sort qw(_qsort stable);
-    my $sort_current; BEGIN { $sort_current = sort::current(); }
-    is($sort_current, 'quicksort stable', 'sort::current for _qsort stable');
+    is($sort_current, 'stable', 'sort::current for stable');
     main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
 }
 
 # Tests added to check "defaults" subpragma, and "no sort"
 
-{
-    use sort qw(_qsort stable);
-    no sort qw(_qsort);
-    my $sort_current; BEGIN { $sort_current = sort::current(); }
-    is($sort_current, 'stable', 'sort::current after no _qsort');
-    main(sub { sort {&{$_[0]}} @{$_[1]} }, 0);
-}
-
-{
-    use sort qw(defaults _qsort);
-    my $sort_current; BEGIN { $sort_current = sort::current(); }
-    is($sort_current, 'quicksort', 'sort::current after defaults _qsort');
-    # Not expected to be stable, so don't test for stability here
-}
-
 {
     use sort qw(defaults stable);
     my $sort_current; BEGIN { $sort_current = sort::current(); }
diff --git a/op.c b/op.c
index 2e4dae4..c8b43f7 100644 (file)
--- a/op.c
+++ b/op.c
@@ -12185,8 +12185,6 @@ Perl_ck_sort(pTHX_ OP *o)
            SV ** const svp = hv_fetchs(hinthv, "sort", FALSE);
            if (svp) {
                const I32 sorthints = (I32)SvIV(*svp);
-               if ((sorthints & HINT_SORT_QUICKSORT) != 0)
-                   o->op_private |= OPpSORT_QSORT;
                if ((sorthints & HINT_SORT_STABLE) != 0)
                    o->op_private |= OPpSORT_STABLE;
                if ((sorthints & HINT_SORT_UNSTABLE) != 0)
index 10e6816..b5ed37f 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -2267,7 +2267,6 @@ END_EXTERN_C
 #define OPpMULTICONCAT_FAKE     0x20
 #define OPpMULTIDEREF_DELETE    0x20
 #define OPpOPEN_IN_CRLF         0x20
-#define OPpSORT_QSORT           0x20
 #define OPpTRANS_COMPLEMENT     0x20
 #define OPpTRUEBOOL             0x20
 #define OPpDEREF                0x30
@@ -2400,7 +2399,6 @@ EXTCONST char PL_op_private_labels[] = {
     'O','U','R','I','N','T','R','\0',
     'O','U','T','B','I','N','\0',
     'O','U','T','C','R','\0',
-    'Q','S','O','R','T','\0',
     'R','E','F','C','\0',
     'R','E','P','A','R','S','E','\0',
     'R','E','P','L','1','S','T','\0',
@@ -2442,14 +2440,14 @@ EXTCONST char PL_op_private_labels[] = {
 EXTCONST I16 PL_op_private_bitfields[] = {
     0, 8, -1,
     0, 8, -1,
-    0, 582, -1,
+    0, 576, -1,
     0, 8, -1,
     0, 8, -1,
-    0, 589, -1,
-    0, 578, -1,
-    1, -1, 0, 546, 1, 40, 2, 290, -1,
+    0, 583, -1,
+    0, 572, -1,
+    1, -1, 0, 540, 1, 40, 2, 290, -1,
     4, -1, 1, 171, 2, 178, 3, 185, -1,
-    4, -1, 0, 546, 1, 40, 2, 290, 3, 117, -1,
+    4, -1, 0, 540, 1, 40, 2, 290, 3, 117, -1,
 
 };
 
@@ -2626,49 +2624,49 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* shift */
       90, /* unshift */
      149, /* sort */
-     157, /* reverse */
+     156, /* reverse */
        0, /* grepstart */
-     159, /* grepwhile */
+     158, /* grepwhile */
        0, /* mapstart */
        0, /* mapwhile */
        0, /* range */
-     161, /* flip */
-     161, /* flop */
+     160, /* flip */
+     160, /* flop */
        0, /* and */
        0, /* or */
       12, /* xor */
        0, /* dor */
-     163, /* cond_expr */
+     162, /* cond_expr */
        0, /* andassign */
        0, /* orassign */
        0, /* dorassign */
-     165, /* entersub */
-     172, /* leavesub */
-     172, /* leavesublv */
+     164, /* entersub */
+     171, /* leavesub */
+     171, /* leavesublv */
        0, /* argcheck */
-     174, /* argelem */
+     173, /* argelem */
        0, /* argdefelem */
-     176, /* caller */
+     175, /* caller */
       52, /* warn */
       52, /* die */
       52, /* reset */
       -1, /* lineseq */
-     178, /* nextstate */
-     178, /* dbstate */
+     177, /* nextstate */
+     177, /* dbstate */
       -1, /* unstack */
       -1, /* enter */
-     179, /* leave */
+     178, /* leave */
       -1, /* scope */
-     181, /* enteriter */
-     185, /* iter */
+     180, /* enteriter */
+     184, /* iter */
       -1, /* enterloop */
-     186, /* leaveloop */
+     185, /* leaveloop */
       -1, /* return */
-     188, /* last */
-     188, /* next */
-     188, /* redo */
-     188, /* dump */
-     188, /* goto */
+     187, /* last */
+     187, /* next */
+     187, /* redo */
+     187, /* dump */
+     187, /* goto */
       52, /* exit */
        0, /* method */
        0, /* method_named */
@@ -2681,7 +2679,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* leavewhen */
       -1, /* break */
       -1, /* continue */
-     190, /* open */
+     189, /* open */
       52, /* close */
       52, /* pipe_op */
       52, /* fileno */
@@ -2697,7 +2695,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       52, /* getc */
       52, /* read */
       52, /* enterwrite */
-     172, /* leavewrite */
+     171, /* leavewrite */
       -1, /* prtf */
       -1, /* print */
       -1, /* say */
@@ -2727,33 +2725,33 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* getpeername */
        0, /* lstat */
        0, /* stat */
-     195, /* ftrread */
-     195, /* ftrwrite */
-     195, /* ftrexec */
-     195, /* fteread */
-     195, /* ftewrite */
-     195, /* fteexec */
-     200, /* ftis */
-     200, /* ftsize */
-     200, /* ftmtime */
-     200, /* ftatime */
-     200, /* ftctime */
-     200, /* ftrowned */
-     200, /* fteowned */
-     200, /* ftzero */
-     200, /* ftsock */
-     200, /* ftchr */
-     200, /* ftblk */
-     200, /* ftfile */
-     200, /* ftdir */
-     200, /* ftpipe */
-     200, /* ftsuid */
-     200, /* ftsgid */
-     200, /* ftsvtx */
-     200, /* ftlink */
-     200, /* fttty */
-     200, /* fttext */
-     200, /* ftbinary */
+     194, /* ftrread */
+     194, /* ftrwrite */
+     194, /* ftrexec */
+     194, /* fteread */
+     194, /* ftewrite */
+     194, /* fteexec */
+     199, /* ftis */
+     199, /* ftsize */
+     199, /* ftmtime */
+     199, /* ftatime */
+     199, /* ftctime */
+     199, /* ftrowned */
+     199, /* fteowned */
+     199, /* ftzero */
+     199, /* ftsock */
+     199, /* ftchr */
+     199, /* ftblk */
+     199, /* ftfile */
+     199, /* ftdir */
+     199, /* ftpipe */
+     199, /* ftsuid */
+     199, /* ftsgid */
+     199, /* ftsvtx */
+     199, /* ftlink */
+     199, /* fttty */
+     199, /* fttext */
+     199, /* ftbinary */
       90, /* chdir */
       90, /* chown */
       75, /* chroot */
@@ -2773,17 +2771,17 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* rewinddir */
        0, /* closedir */
       -1, /* fork */
-     204, /* wait */
+     203, /* wait */
       90, /* waitpid */
       90, /* system */
       90, /* exec */
       90, /* kill */
-     204, /* getppid */
+     203, /* getppid */
       90, /* getpgrp */
       90, /* setpgrp */
       90, /* getpriority */
       90, /* setpriority */
-     204, /* time */
+     203, /* time */
       -1, /* tms */
        0, /* localtime */
       52, /* gmtime */
@@ -2803,8 +2801,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* require */
        0, /* dofile */
       -1, /* hintseval */
-     205, /* entereval */
-     172, /* leaveeval */
+     204, /* entereval */
+     171, /* leaveeval */
        0, /* entertry */
       -1, /* leavetry */
        0, /* ghbyname */
@@ -2842,18 +2840,18 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* lock */
        0, /* once */
       -1, /* custom */
-     211, /* coreargs */
-     215, /* avhvswitch */
+     210, /* coreargs */
+     214, /* avhvswitch */
        3, /* runcv */
        0, /* fc */
       -1, /* padcv */
       -1, /* introcv */
       -1, /* clonecv */
-     217, /* padrange */
-     219, /* refassign */
-     225, /* lvref */
-     231, /* lvrefslice */
-     232, /* lvavref */
+     216, /* padrange */
+     218, /* refassign */
+     224, /* lvref */
+     230, /* lvrefslice */
+     231, /* lvavref */
        0, /* anonconst */
 
 };
@@ -2874,74 +2872,74 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
 
 EXTCONST U16  PL_op_private_bitdefs[] = {
     0x0003, /* scalar, prototype, refgen, srefgen, readline, regcmaybe, regcreset, regcomp, substcont, chop, schop, defined, undef, study, preinc, i_preinc, predec, i_predec, postinc, i_postinc, postdec, i_postdec, negate, i_negate, not, complement, ucfirst, lcfirst, uc, lc, quotemeta, aeach, avalues, each, pop, shift, grepstart, mapstart, mapwhile, range, and, or, dor, andassign, orassign, dorassign, argcheck, argdefelem, method, method_named, method_super, method_redir, method_redir_super, entergiven, leavegiven, enterwhen, leavewhen, untie, tied, dbmclose, getsockname, getpeername, lstat, stat, readlink, readdir, telldir, rewinddir, closedir, localtime, alarm, require, dofile, entertry, ghbyname, gnbyname, gpbyname, shostent, snetent, sprotoent, sservent, gpwnam, gpwuid, ggrnam, ggrgid, lock, once, fc, anonconst */
-    0x2f3c, 0x40f9, /* pushmark */
+    0x2f3c, 0x4039, /* pushmark */
     0x00bd, /* wantarray, runcv */
-    0x0578, 0x19b0, 0x41ac, 0x3c68, 0x3385, /* const */
+    0x0578, 0x19b0, 0x40ec, 0x3ba8, 0x3385, /* const */
     0x2f3c, 0x34d9, /* gvsv */
     0x1815, /* gv */
     0x0067, /* gelem, lt, i_lt, gt, i_gt, le, i_le, ge, i_ge, eq, i_eq, ne, i_ne, ncmp, i_ncmp, slt, sgt, sle, sge, seq, sne, scmp, bit_and, bit_xor, bit_or, sbit_and, sbit_xor, sbit_or, smartmatch, lslice, xor */
-    0x2f3c, 0x40f8, 0x03d7, /* padsv */
-    0x2f3c, 0x40f8, 0x06f4, 0x302c, 0x3de9, /* padav */
-    0x2f3c, 0x40f8, 0x06f4, 0x0790, 0x302c, 0x3de8, 0x2aa1, /* padhv */
-    0x2f3c, 0x1b98, 0x03d6, 0x302c, 0x32a8, 0x41a4, 0x0003, /* rv2gv */
-    0x2f3c, 0x34d8, 0x03d6, 0x41a4, 0x0003, /* rv2sv */
+    0x2f3c, 0x4038, 0x03d7, /* padsv */
+    0x2f3c, 0x4038, 0x06f4, 0x302c, 0x3d29, /* padav */
+    0x2f3c, 0x4038, 0x06f4, 0x0790, 0x302c, 0x3d28, 0x2aa1, /* padhv */
+    0x2f3c, 0x1b98, 0x03d6, 0x302c, 0x32a8, 0x40e4, 0x0003, /* rv2gv */
+    0x2f3c, 0x34d8, 0x03d6, 0x40e4, 0x0003, /* rv2sv */
     0x302c, 0x0003, /* av2arylen, akeys, values, keys */
-    0x321c, 0x0fd8, 0x0d34, 0x028c, 0x44a8, 0x41a4, 0x0003, /* rv2cv */
+    0x321c, 0x0fd8, 0x0d34, 0x028c, 0x43e8, 0x40e4, 0x0003, /* rv2cv */
     0x06f4, 0x0790, 0x0003, /* ref */
     0x018f, /* bless, glob, sprintf, formline, unpack, pack, join, anonlist, anonhash, splice, warn, die, reset, exit, close, pipe_op, fileno, umask, binmode, tie, dbmopen, sselect, select, getc, read, enterwrite, sysopen, sysseek, sysread, syswrite, eof, tell, seek, truncate, fcntl, ioctl, send, recv, socket, sockpair, bind, connect, listen, accept, shutdown, gsockopt, ssockopt, open_dir, seekdir, gmtime, shmget, shmctl, shmread, shmwrite, msgget, msgctl, msgsnd, msgrcv, semop, semget, semctl, ghbyaddr, gnbyaddr, gpbynumber, gsbyname, gsbyport, syscall */
     0x36bc, 0x35d8, 0x27f4, 0x2730, 0x0003, /* backtick */
     0x06f5, /* subst */
-    0x10dc, 0x2118, 0x0914, 0x3f2c, 0x24a8, 0x01e4, 0x0141, /* trans, transr */
+    0x10dc, 0x2118, 0x0914, 0x3e6c, 0x24a8, 0x01e4, 0x0141, /* trans, transr */
     0x0f1c, 0x0618, 0x0067, /* sassign */
     0x0bd8, 0x0ad4, 0x09d0, 0x302c, 0x06e8, 0x0067, /* aassign */
-    0x4550, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */
+    0x4490, 0x0003, /* chomp, schomp, ncomplement, scomplement, sin, cos, exp, log, sqrt, int, hex, oct, abs, ord, chr, chroot, rmdir */
     0x06f4, 0x302c, 0x0003, /* pos */
-    0x4550, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
+    0x4490, 0x0067, /* pow, multiply, i_multiply, divide, i_divide, modulo, i_modulo, add, i_add, subtract, i_subtract, concat, left_shift, right_shift, nbit_and, nbit_xor, nbit_or */
     0x1498, 0x0067, /* repeat */
-    0x2f3c, 0x0358, 0x1b94, 0x4550, 0x428c, 0x0003, /* multiconcat */
-    0x4550, 0x018f, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
-    0x06f4, 0x4550, 0x0003, /* length */
-    0x39d0, 0x302c, 0x012b, /* substr */
+    0x2f3c, 0x0358, 0x1b94, 0x4490, 0x41cc, 0x0003, /* multiconcat */
+    0x4490, 0x018f, /* stringify, atan2, rand, srand, crypt, push, unshift, flock, chdir, chown, unlink, chmod, utime, rename, link, symlink, mkdir, waitpid, system, exec, kill, getpgrp, setpgrp, getpriority, setpriority, sleep */
+    0x06f4, 0x4490, 0x0003, /* length */
+    0x3910, 0x302c, 0x012b, /* substr */
     0x302c, 0x0067, /* vec */
-    0x3198, 0x06f4, 0x4550, 0x018f, /* index, rindex */
-    0x2f3c, 0x34d8, 0x06f4, 0x302c, 0x3de8, 0x41a4, 0x0003, /* rv2av */
+    0x3198, 0x06f4, 0x4490, 0x018f, /* index, rindex */
+    0x2f3c, 0x34d8, 0x06f4, 0x302c, 0x3d28, 0x40e4, 0x0003, /* rv2av */
     0x025f, /* aelemfast, aelemfast_lex */
     0x2f3c, 0x2e38, 0x03d6, 0x302c, 0x0067, /* aelem, helem */
-    0x2f3c, 0x302c, 0x3de9, /* aslice, hslice */
+    0x2f3c, 0x302c, 0x3d29, /* aslice, hslice */
     0x302d, /* kvaslice, kvhslice */
-    0x2f3c, 0x3d38, 0x2b54, 0x0003, /* delete */
-    0x43d8, 0x0003, /* exists */
-    0x2f3c, 0x34d8, 0x06f4, 0x0790, 0x302c, 0x3de8, 0x41a4, 0x2aa1, /* rv2hv */
-    0x2f3c, 0x2e38, 0x1154, 0x1ab0, 0x302c, 0x41a4, 0x0003, /* multideref */
+    0x2f3c, 0x3c78, 0x2b54, 0x0003, /* delete */
+    0x4318, 0x0003, /* exists */
+    0x2f3c, 0x34d8, 0x06f4, 0x0790, 0x302c, 0x3d28, 0x40e4, 0x2aa1, /* rv2hv */
+    0x2f3c, 0x2e38, 0x1154, 0x1ab0, 0x302c, 0x40e4, 0x0003, /* multideref */
     0x2f3c, 0x34d8, 0x0430, 0x2c4c, 0x2569, /* split */
     0x2f3c, 0x21d9, /* list */
-    0x46bc, 0x4018, 0x3774, 0x13f0, 0x288c, 0x3ac8, 0x2984, 0x3441, /* sort */
+    0x45fc, 0x3f58, 0x13f0, 0x288c, 0x3a08, 0x2984, 0x3441, /* sort */
     0x288c, 0x0003, /* reverse */
     0x06f4, 0x0003, /* grepwhile */
     0x2cd8, 0x0003, /* flip, flop */
     0x2f3c, 0x0003, /* cond_expr */
-    0x2f3c, 0x0fd8, 0x03d6, 0x028c, 0x44a8, 0x41a4, 0x2641, /* entersub */
-    0x3838, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
+    0x2f3c, 0x0fd8, 0x03d6, 0x028c, 0x43e8, 0x40e4, 0x2641, /* entersub */
+    0x3778, 0x0003, /* leavesub, leavesublv, leavewrite, leaveeval */
     0x02aa, 0x0003, /* argelem */
     0x00bc, 0x018f, /* caller */
     0x23b5, /* nextstate, dbstate */
-    0x2ddc, 0x3839, /* leave */
-    0x2f3c, 0x34d8, 0x104c, 0x3b45, /* enteriter */
-    0x3b45, /* iter */
+    0x2ddc, 0x3779, /* leave */
+    0x2f3c, 0x34d8, 0x104c, 0x3a85, /* enteriter */
+    0x3a85, /* iter */
     0x2ddc, 0x0067, /* leaveloop */
-    0x47dc, 0x0003, /* last, next, redo, dump, goto */
+    0x471c, 0x0003, /* last, next, redo, dump, goto */
     0x36bc, 0x35d8, 0x27f4, 0x2730, 0x018f, /* open */
     0x1d50, 0x1fac, 0x1e68, 0x1c24, 0x0003, /* ftrread, ftrwrite, ftrexec, fteread, ftewrite, fteexec */
     0x1d50, 0x1fac, 0x1e68, 0x0003, /* ftis, ftsize, ftmtime, ftatime, ftctime, ftrowned, fteowned, ftzero, ftsock, ftchr, ftblk, ftfile, ftdir, ftpipe, ftsuid, ftsgid, ftsvtx, ftlink, fttty, fttext, ftbinary */
-    0x4551, /* wait, getppid, time */
-    0x38d4, 0x0df0, 0x084c, 0x4628, 0x22c4, 0x0003, /* entereval */
+    0x4491, /* wait, getppid, time */
+    0x3814, 0x0df0, 0x084c, 0x4568, 0x22c4, 0x0003, /* entereval */
     0x30fc, 0x0018, 0x1304, 0x1221, /* coreargs */
     0x302c, 0x00c7, /* avhvswitch */
     0x2f3c, 0x01fb, /* padrange */
-    0x2f3c, 0x40f8, 0x04f6, 0x2a0c, 0x1908, 0x0067, /* refassign */
-    0x2f3c, 0x40f8, 0x04f6, 0x2a0c, 0x1908, 0x0003, /* lvref */
+    0x2f3c, 0x4038, 0x04f6, 0x2a0c, 0x1908, 0x0067, /* refassign */
+    0x2f3c, 0x4038, 0x04f6, 0x2a0c, 0x1908, 0x0003, /* lvref */
     0x2f3d, /* lvrefslice */
-    0x2f3c, 0x40f8, 0x0003, /* lvavref */
+    0x2f3c, 0x4038, 0x0003, /* lvavref */
 
 };
 
@@ -3117,7 +3115,7 @@ EXTCONST U8 PL_op_private_valid[] = {
     /* POP        */ (OPpARG1_MASK),
     /* SHIFT      */ (OPpARG1_MASK),
     /* UNSHIFT    */ (OPpARG4_MASK|OPpTARGET_MY),
-    /* SORT       */ (OPpSORT_NUMERIC|OPpSORT_INTEGER|OPpSORT_REVERSE|OPpSORT_INPLACE|OPpSORT_DESCEND|OPpSORT_QSORT|OPpSORT_STABLE|OPpSORT_UNSTABLE),
+    /* SORT       */ (OPpSORT_NUMERIC|OPpSORT_INTEGER|OPpSORT_REVERSE|OPpSORT_INPLACE|OPpSORT_DESCEND|OPpSORT_STABLE|OPpSORT_UNSTABLE),
     /* REVERSE    */ (OPpARG1_MASK|OPpREVERSE_INPLACE),
     /* GREPSTART  */ (OPpARG1_MASK),
     /* GREPWHILE  */ (OPpARG1_MASK|OPpTRUEBOOL),
diff --git a/perl.h b/perl.h
index 23f209c..b6d3a3e 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -4938,9 +4938,6 @@ typedef enum {
                                 */
 
 /* The following are stored in $^H{sort}, not in PL_hints */
-#define HINT_SORT_SORT_BITS    0x000000FF /* allow 256 different ones */
-#define HINT_SORT_QUICKSORT    0x00000001
-#define HINT_SORT_MERGESORT    0x00000002
 #define HINT_SORT_STABLE       0x00000100 /* sort styles */
 #define HINT_SORT_UNSTABLE     0x00000200
 
index 03d545c..9f2abcf 100644 (file)
@@ -97,6 +97,18 @@ method will undo it, since method calls cache things in typeglobs.
 
 [perl #129916] [perl #132252]
 
+=head2 Sort algorithm can no longer be specified
+
+Since Perl 5.8, the L<sort> pragma has had subpragmata C<_mergesort>,
+C<_quicksort>, and C<_qsort> that can be used to specify which algorithm
+perl should use to implement the L<sort|perlfunc/sort> builtin.
+This was always considered a dubious feature that might not last,
+hence the underscore spellings, and they were documented as not being
+portable beyond Perl 5.8.  These subpragmata have now been deleted,
+and any attempt to use them is an error.  The L<sort> pragma otherwise
+remains, and the algorithm-neutral C<stable> subpragma can be used to
+control sorting behaviour.
+
 =head1 Deprecations
 
 XXX Any deprecated features, syntax, modules etc. should be listed here.
index 5cced5a..ee8ec3d 100644 (file)
@@ -7264,7 +7264,7 @@ sockets but not socketpair.
 Portability issues: L<perlport/socketpair>.
 
 =item sort SUBNAME LIST
-X<sort> X<qsort> X<quicksort> X<mergesort>
+X<sort>
 
 =item sort BLOCK LIST
 
@@ -7316,19 +7316,9 @@ L<C<grep>|/grep BLOCK LIST>)
 actually modifies the element in the original list.  This is usually
 something to be avoided when writing clear code.
 
-Perl 5.6 and earlier used a quicksort algorithm to implement sort.
-That algorithm was not stable and I<could> go quadratic.  (A I<stable> sort
-preserves the input order of elements that compare equal.  Although
-quicksort's run time is O(NlogN) when averaged over all arrays of
-length N, the time can be O(N**2), I<quadratic> behavior, for some
-inputs.)  In 5.7, the quicksort implementation was replaced with
-a stable mergesort algorithm whose worst-case behavior is O(NlogN).
-But benchmarks indicated that for some inputs, on some platforms,
-the original quicksort was faster.  5.8 has a L<sort> pragma for
-limited control of the sort.  Its rather blunt control of the
-underlying algorithm may not persist into future Perls, but the
-ability to characterize the input or output in implementation
-independent ways quite probably will.
+Historically Perl has varied in whether sorting is stable by default.
+If stability matters, it can be controlled explicitly by using the
+L<sort> pragma.
 
 Examples:
 
@@ -7411,14 +7401,10 @@ Examples:
     package main;
     my @new = sort Other::backwards @old;
 
-    # guarantee stability, regardless of algorithm
+    # guarantee stability
     use sort 'stable';
     my @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
 
-    # force use of mergesort (not portable outside Perl 5.8)
-    use sort '_mergesort';  # note discouraging _
-    my @new = sort { substr($a, 3, 5) cmp substr($b, 3, 5) } @old;
-
 Warning: syntactical care is required when sorting the list returned from
 a function.  If you want to sort the list returned by the function call
 C<find_records(@key)>, you can use:
@@ -9418,7 +9404,7 @@ pragmas are:
     use strict   qw(subs vars refs);
     use subs     qw(afunc blurfl);
     use warnings qw(all);
-    use sort     qw(stable _quicksort _mergesort);
+    use sort     qw(stable);
 
 Some of these pseudo-modules import semantics into the current
 block scope (like L<C<strict>|strict> or L<C<integer>|integer>, unlike
index 3635ec3..ab126f7 100644 (file)
@@ -574,7 +574,7 @@ Perl running out of memory.
 =item *
 
 Sorting - the quicksort algorithm used in Perls before 5.8.0 to
-implement the sort() function is very easy to trick into misbehaving
+implement the sort() function was very easy to trick into misbehaving
 so that it consumes a lot of time.  Starting from Perl 5.8.0 a different
 sorting algorithm, mergesort, is used by default.  Mergesort cannot
 misbehave on any input.
index 9d31bda..fb4e2f8 100644 (file)
--- a/pp_sort.c
+++ b/pp_sort.c
@@ -45,7 +45,6 @@
 /* Flags for qsortsv and mergesortsv */
 #define SORTf_DESC   1
 #define SORTf_STABLE 2
-#define SORTf_QSORT  4
 #define SORTf_UNSTABLE 8
 
 /*
@@ -351,8 +350,16 @@ cmp_desc(pTHX_ gptr const a, gptr const b)
     return -PL_sort_RealCmp(aTHX_ a, b);
 }
 
-STATIC void
-S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
+/*
+=for apidoc sortsv_flags
+
+In-place sort an array of SV pointers with the given comparison routine,
+with various SORTf_* flag options.
+
+=cut
+*/
+void
+Perl_sortsv_flags(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
 {
     IV i, run, offset;
     I32 sense, level;
@@ -365,6 +372,7 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
     off_runs stack[60], *stackp;
     SVCOMPARE_t savecmp = NULL;
 
+    PERL_ARGS_ASSERT_SORTSV_FLAGS;
     if (nmemb <= 1) return;                    /* sorted trivially */
 
     if ((flags & SORTf_DESC) != 0) {
@@ -760,670 +768,6 @@ doqsort_all_asserts(
 
 #endif
 
-/* ****************************************************************** qsort */
-
-STATIC void /* the standard unstable (u) quicksort (qsort) */
-S_qsortsvu(pTHX_ SV ** array, size_t num_elts, SVCOMPARE_t compare)
-{
-   SV * temp;
-   struct partition_stack_entry partition_stack[QSORT_MAX_STACK];
-   int next_stack_entry = 0;
-   int part_left;
-   int part_right;
-#ifdef QSORT_ORDER_GUESS
-   int qsort_break_even;
-   int swapped;
-#endif
-
-    PERL_ARGS_ASSERT_QSORTSVU;
-
-   /* Make sure we actually have work to do.
-   */
-   if (num_elts <= 1) {
-      return;
-   }
-
-   /* Inoculate large partitions against quadratic behavior */
-   if (num_elts > QSORT_PLAY_SAFE) {
-      size_t n;
-      SV ** const q = array;
-      for (n = num_elts; n > 1; ) {
-         const size_t j = (size_t)(n-- * Perl_internal_drand48());
-         temp = q[j];
-         q[j] = q[n];
-         q[n] = temp;
-      }
-   }
-
-   /* Setup the initial partition definition and fall into the sorting loop
-   */
-   part_left = 0;
-   part_right = (int)(num_elts - 1);
-#ifdef QSORT_ORDER_GUESS
-   qsort_break_even = QSORT_BREAK_EVEN;
-#else
-#define qsort_break_even QSORT_BREAK_EVEN
-#endif
-   for ( ; ; ) {
-      if ((part_right - part_left) >= qsort_break_even) {
-         /* OK, this is gonna get hairy, so lets try to document all the
-            concepts and abbreviations and variables and what they keep
-            track of:
-
-            pc: pivot chunk - the set of array elements we accumulate in the
-                middle of the partition, all equal in value to the original
-                pivot element selected. The pc is defined by:
-
-                pc_left - the leftmost array index of the pc
-                pc_right - the rightmost array index of the pc
-
-                we start with pc_left == pc_right and only one element
-                in the pivot chunk (but it can grow during the scan).
-
-            u:  uncompared elements - the set of elements in the partition
-                we have not yet compared to the pivot value. There are two
-                uncompared sets during the scan - one to the left of the pc
-                and one to the right.
-
-                u_right - the rightmost index of the left side's uncompared set
-                u_left - the leftmost index of the right side's uncompared set
-
-                The leftmost index of the left sides's uncompared set
-                doesn't need its own variable because it is always defined
-                by the leftmost edge of the whole partition (part_left). The
-                same goes for the rightmost edge of the right partition
-                (part_right).
-
-                We know there are no uncompared elements on the left once we
-                get u_right < part_left and no uncompared elements on the
-                right once u_left > part_right. When both these conditions
-                are met, we have completed the scan of the partition.
-
-                Any elements which are between the pivot chunk and the
-                uncompared elements should be less than the pivot value on
-                the left side and greater than the pivot value on the right
-                side (in fact, the goal of the whole algorithm is to arrange
-                for that to be true and make the groups of less-than and
-                greater-then elements into new partitions to sort again).
-
-            As you marvel at the complexity of the code and wonder why it
-            has to be so confusing. Consider some of the things this level
-            of confusion brings:
-
-            Once I do a compare, I squeeze every ounce of juice out of it. I
-            never do compare calls I don't have to do, and I certainly never
-            do redundant calls.
-
-            I also never swap any elements unless I can prove there is a
-            good reason. Many sort algorithms will swap a known value with
-            an uncompared value just to get things in the right place (or
-            avoid complexity :-), but that uncompared value, once it gets
-            compared, may then have to be swapped again. A lot of the
-            complexity of this code is due to the fact that it never swaps
-            anything except compared values, and it only swaps them when the
-            compare shows they are out of position.
-         */
-         int pc_left, pc_right;
-         int u_right, u_left;
-
-         int s;
-
-         pc_left = ((part_left + part_right) / 2);
-         pc_right = pc_left;
-         u_right = pc_left - 1;
-         u_left = pc_right + 1;
-
-         /* Qsort works best when the pivot value is also the median value
-            in the partition (unfortunately you can't find the median value
-            without first sorting :-), so to give the algorithm a helping
-            hand, we pick 3 elements and sort them and use the median value
-            of that tiny set as the pivot value.
-
-            Some versions of qsort like to use the left middle and right as
-            the 3 elements to sort so they can insure the ends of the
-            partition will contain values which will stop the scan in the
-            compare loop, but when you have to call an arbitrarily complex
-            routine to do a compare, its really better to just keep track of
-            array index values to know when you hit the edge of the
-            partition and avoid the extra compare. An even better reason to
-            avoid using a compare call is the fact that you can drop off the
-            edge of the array if someone foolishly provides you with an
-            unstable compare function that doesn't always provide consistent
-            results.
-
-            So, since it is simpler for us to compare the three adjacent
-            elements in the middle of the partition, those are the ones we
-            pick here (conveniently pointed at by u_right, pc_left, and
-            u_left). The values of the left, center, and right elements
-            are referred to as l c and r in the following comments.
-         */
-
-#ifdef QSORT_ORDER_GUESS
-         swapped = 0;
-#endif
-         s = qsort_cmp(u_right, pc_left);
-         if (s < 0) {
-            /* l < c */
-            s = qsort_cmp(pc_left, u_left);
-            /* if l < c, c < r - already in order - nothing to do */
-            if (s == 0) {
-               /* l < c, c == r - already in order, pc grows */
-               ++pc_right;
-               qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-            } else if (s > 0) {
-               /* l < c, c > r - need to know more */
-               s = qsort_cmp(u_right, u_left);
-               if (s < 0) {
-                  /* l < c, c > r, l < r - swap c & r to get ordered */
-                  qsort_swap(pc_left, u_left);
-                  qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-               } else if (s == 0) {
-                  /* l < c, c > r, l == r - swap c&r, grow pc */
-                  qsort_swap(pc_left, u_left);
-                  --pc_left;
-                  qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-               } else {
-                  /* l < c, c > r, l > r - make lcr into rlc to get ordered */
-                  qsort_rotate(pc_left, u_right, u_left);
-                  qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-               }
-            }
-         } else if (s == 0) {
-            /* l == c */
-            s = qsort_cmp(pc_left, u_left);
-            if (s < 0) {
-               /* l == c, c < r - already in order, grow pc */
-               --pc_left;
-               qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-            } else if (s == 0) {
-               /* l == c, c == r - already in order, grow pc both ways */
-               --pc_left;
-               ++pc_right;
-               qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-            } else {
-               /* l == c, c > r - swap l & r, grow pc */
-               qsort_swap(u_right, u_left);
-               ++pc_right;
-               qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-            }
-         } else {
-            /* l > c */
-            s = qsort_cmp(pc_left, u_left);
-            if (s < 0) {
-               /* l > c, c < r - need to know more */
-               s = qsort_cmp(u_right, u_left);
-               if (s < 0) {
-                  /* l > c, c < r, l < r - swap l & c to get ordered */
-                  qsort_swap(u_right, pc_left);
-                  qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-               } else if (s == 0) {
-                  /* l > c, c < r, l == r - swap l & c, grow pc */
-                  qsort_swap(u_right, pc_left);
-                  ++pc_right;
-                  qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-               } else {
-                  /* l > c, c < r, l > r - rotate lcr into crl to order */
-                  qsort_rotate(u_right, pc_left, u_left);
-                  qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-               }
-            } else if (s == 0) {
-               /* l > c, c == r - swap ends, grow pc */
-               qsort_swap(u_right, u_left);
-               --pc_left;
-               qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-            } else {
-               /* l > c, c > r - swap ends to get in order */
-               qsort_swap(u_right, u_left);
-               qsort_all_asserts(pc_left, pc_right, u_left + 1, u_right - 1);
-            }
-         }
-         /* We now know the 3 middle elements have been compared and
-            arranged in the desired order, so we can shrink the uncompared
-            sets on both sides
-         */
-         --u_right;
-         ++u_left;
-         qsort_all_asserts(pc_left, pc_right, u_left, u_right);
-
-         /* The above massive nested if was the simple part :-). We now have
-            the middle 3 elements ordered and we need to scan through the
-            uncompared sets on either side, swapping elements that are on
-            the wrong side or simply shuffling equal elements around to get
-            all equal elements into the pivot chunk.
-         */
-
-         for ( ; ; ) {
-            int still_work_on_left;
-            int still_work_on_right;
-
-            /* Scan the uncompared values on the left. If I find a value
-               equal to the pivot value, move it over so it is adjacent to
-               the pivot chunk and expand the pivot chunk. If I find a value
-               less than the pivot value, then just leave it - its already
-               on the correct side of the partition. If I find a greater
-               value, then stop the scan.
-            */
-            while ((still_work_on_left = (u_right >= part_left))) {
-               s = qsort_cmp(u_right, pc_left);
-               if (s < 0) {
-                  --u_right;
-               } else if (s == 0) {
-                  --pc_left;
-                  if (pc_left != u_right) {
-                     qsort_swap(u_right, pc_left);
-                  }
-                  --u_right;
-               } else {
-                  break;
-               }
-               qsort_assert(u_right < pc_left);
-               qsort_assert(pc_left <= pc_right);
-               qsort_assert(qsort_cmp(u_right + 1, pc_left) <= 0);
-               qsort_assert(qsort_cmp(pc_left, pc_right) == 0);
-            }
-
-            /* Do a mirror image scan of uncompared values on the right
-            */
-            while ((still_work_on_right = (u_left <= part_right))) {
-               s = qsort_cmp(pc_right, u_left);
-               if (s < 0) {
-                  ++u_left;
-               } else if (s == 0) {
-                  ++pc_right;
-                  if (pc_right != u_left) {
-                     qsort_swap(pc_right, u_left);
-                  }
-                  ++u_left;
-               } else {
-                  break;
-               }
-               qsort_assert(u_left > pc_right);
-               qsort_assert(pc_left <= pc_right);
-               qsort_assert(qsort_cmp(pc_right, u_left - 1) <= 0);
-               qsort_assert(qsort_cmp(pc_left, pc_right) == 0);
-            }
-
-            if (still_work_on_left) {
-               /* I know I have a value on the left side which needs to be
-                  on the right side, but I need to know more to decide
-                  exactly the best thing to do with it.
-               */
-               if (still_work_on_right) {
-                  /* I know I have values on both side which are out of
-                     position. This is a big win because I kill two birds
-                     with one swap (so to speak). I can advance the
-                     uncompared pointers on both sides after swapping both
-                     of them into the right place.
-                  */
-                  qsort_swap(u_right, u_left);
-                  --u_right;
-                  ++u_left;
-                  qsort_all_asserts(pc_left, pc_right, u_left, u_right);
-               } else {
-                  /* I have an out of position value on the left, but the
-                     right is fully scanned, so I "slide" the pivot chunk
-                     and any less-than values left one to make room for the
-                     greater value over on the right. If the out of position
-                     value is immediately adjacent to the pivot chunk (there
-                     are no less-than values), I can do that with a swap,
-                     otherwise, I have to rotate one of the less than values
-                     into the former position of the out of position value
-                     and the right end of the pivot chunk into the left end
-                     (got all that?).
-                  */
-                  --pc_left;
-                  if (pc_left == u_right) {
-                     qsort_swap(u_right, pc_right);
-                     qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1);
-                  } else {
-                     qsort_rotate(u_right, pc_left, pc_right);
-                     qsort_all_asserts(pc_left, pc_right-1, u_left, u_right-1);
-                  }
-                  --pc_right;
-                  --u_right;
-               }
-            } else if (still_work_on_right) {
-               /* Mirror image of complex case above: I have an out of
-                  position value on the right, but the left is fully
-                  scanned, so I need to shuffle things around to make room
-                  for the right value on the left.
-               */
-               ++pc_right;
-               if (pc_right == u_left) {
-                  qsort_swap(u_left, pc_left);
-                  qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right);
-               } else {
-                  qsort_rotate(pc_right, pc_left, u_left);
-                  qsort_all_asserts(pc_left+1, pc_right, u_left+1, u_right);
-               }
-               ++pc_left;
-               ++u_left;
-            } else {
-               /* No more scanning required on either side of partition,
-                  break out of loop and figure out next set of partitions
-               */
-               break;
-            }
-         }
-
-         /* The elements in the pivot chunk are now in the right place. They
-            will never move or be compared again. All I have to do is decide
-            what to do with the stuff to the left and right of the pivot
-            chunk.
-
-            Notes on the QSORT_ORDER_GUESS ifdef code:
-
-            1. If I just built these partitions without swapping any (or
-               very many) elements, there is a chance that the elements are
-               already ordered properly (being properly ordered will
-               certainly result in no swapping, but the converse can't be
-               proved :-).
-
-            2. A (properly written) insertion sort will run faster on
-               already ordered data than qsort will.
-
-            3. Perhaps there is some way to make a good guess about
-               switching to an insertion sort earlier than partition size 6
-               (for instance - we could save the partition size on the stack
-               and increase the size each time we find we didn't swap, thus
-               switching to insertion sort earlier for partitions with a
-               history of not swapping).
-
-            4. Naturally, if I just switch right away, it will make
-               artificial benchmarks with pure ascending (or descending)
-               data look really good, but is that a good reason in general?
-               Hard to say...
-         */
-
-#ifdef QSORT_ORDER_GUESS
-         if (swapped < 3) {
-#if QSORT_ORDER_GUESS == 1
-            qsort_break_even = (part_right - part_left) + 1;
-#endif
-#if QSORT_ORDER_GUESS == 2
-            qsort_break_even *= 2;
-#endif
-#if QSORT_ORDER_GUESS == 3
-            const int prev_break = qsort_break_even;
-            qsort_break_even *= qsort_break_even;
-            if (qsort_break_even < prev_break) {
-               qsort_break_even = (part_right - part_left) + 1;
-            }
-#endif
-         } else {
-            qsort_break_even = QSORT_BREAK_EVEN;
-         }
-#endif
-
-         if (part_left < pc_left) {
-            /* There are elements on the left which need more processing.
-               Check the right as well before deciding what to do.
-            */
-            if (pc_right < part_right) {
-               /* We have two partitions to be sorted. Stack the biggest one
-                  and process the smallest one on the next iteration. This
-                  minimizes the stack height by insuring that any additional
-                  stack entries must come from the smallest partition which
-                  (because it is smallest) will have the fewest
-                  opportunities to generate additional stack entries.
-               */
-               if ((part_right - pc_right) > (pc_left - part_left)) {
-                  /* stack the right partition, process the left */
-                  partition_stack[next_stack_entry].left = pc_right + 1;
-                  partition_stack[next_stack_entry].right = part_right;
-#ifdef QSORT_ORDER_GUESS
-                  partition_stack[next_stack_entry].qsort_break_even = qsort_break_even;
-#endif
-                  part_right = pc_left - 1;
-               } else {
-                  /* stack the left partition, process the right */
-                  partition_stack[next_stack_entry].left = part_left;
-                  partition_stack[next_stack_entry].right = pc_left - 1;
-#ifdef QSORT_ORDER_GUESS
-                  partition_stack[next_stack_entry].qsort_break_even = qsort_break_even;
-#endif
-                  part_left = pc_right + 1;
-               }
-               qsort_assert(next_stack_entry < QSORT_MAX_STACK);
-               ++next_stack_entry;
-            } else {
-               /* The elements on the left are the only remaining elements
-                  that need sorting, arrange for them to be processed as the
-                  next partition.
-               */
-               part_right = pc_left - 1;
-            }
-         } else if (pc_right < part_right) {
-            /* There is only one chunk on the right to be sorted, make it
-               the new partition and loop back around.
-            */
-            part_left = pc_right + 1;
-         } else {
-            /* This whole partition wound up in the pivot chunk, so
-               we need to get a new partition off the stack.
-            */
-            if (next_stack_entry == 0) {
-               /* the stack is empty - we are done */
-               break;
-            }
-            --next_stack_entry;
-            part_left = partition_stack[next_stack_entry].left;
-            part_right = partition_stack[next_stack_entry].right;
-#ifdef QSORT_ORDER_GUESS
-            qsort_break_even = partition_stack[next_stack_entry].qsort_break_even;
-#endif
-         }
-      } else {
-         /* This partition is too small to fool with qsort complexity, just
-            do an ordinary insertion sort to minimize overhead.
-         */
-         int i;
-         /* Assume 1st element is in right place already, and start checking
-            at 2nd element to see where it should be inserted.
-         */
-         for (i = part_left + 1; i <= part_right; ++i) {
-            int j;
-            /* Scan (backwards - just in case 'i' is already in right place)
-               through the elements already sorted to see if the ith element
-               belongs ahead of one of them.
-            */
-            for (j = i - 1; j >= part_left; --j) {
-               if (qsort_cmp(i, j) >= 0) {
-                  /* i belongs right after j
-                  */
-                  break;
-               }
-            }
-            ++j;
-            if (j != i) {
-               /* Looks like we really need to move some things
-               */
-              int k;
-              temp = array[i];
-              for (k = i - 1; k >= j; --k)
-                 array[k + 1] = array[k];
-               array[j] = temp;
-            }
-         }
-
-         /* That partition is now sorted, grab the next one, or get out
-            of the loop if there aren't any more.
-         */
-
-         if (next_stack_entry == 0) {
-            /* the stack is empty - we are done */
-            break;
-         }
-         --next_stack_entry;
-         part_left = partition_stack[next_stack_entry].left;
-         part_right = partition_stack[next_stack_entry].right;
-#ifdef QSORT_ORDER_GUESS
-         qsort_break_even = partition_stack[next_stack_entry].qsort_break_even;
-#endif
-      }
-   }
-
-   /* Believe it or not, the array is sorted at this point! */
-}
-
-/* Stabilize what is, presumably, an otherwise unstable sort method.
- * We do that by allocating (or having on hand) an array of pointers
- * that is the same size as the original array of elements to be sorted.
- * We initialize this parallel array with the addresses of the original
- * array elements.  This indirection can make you crazy.
- * Some pictures can help.  After initializing, we have
- *
- *  indir                  list1
- * +----+                 +----+
- * |    | --------------> |    | ------> first element to be sorted
- * +----+                 +----+
- * |    | --------------> |    | ------> second element to be sorted
- * +----+                 +----+
- * |    | --------------> |    | ------> third element to be sorted
- * +----+                 +----+
- *  ...
- * +----+                 +----+
- * |    | --------------> |    | ------> n-1st element to be sorted
- * +----+                 +----+
- * |    | --------------> |    | ------> n-th element to be sorted
- * +----+                 +----+
- *
- * During the sort phase, we leave the elements of list1 where they are,
- * and sort the pointers in the indirect array in the same order determined
- * 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 stability.
- * This leaves us with something looking like
- *
- *  indir                  list1
- * +----+                 +----+
- * |    | --+       +---> |    | ------> first element to be sorted
- * +----+   |       |     +----+
- * |    | --|-------|---> |    | ------> second element to be sorted
- * +----+   |       |     +----+
- * |    | --|-------+ +-> |    | ------> third element to be sorted
- * +----+   |         |   +----+
- *  ...
- * +----+    | |   | |    +----+
- * |    | ---|-+   | +--> |    | ------> n-1st element to be sorted
- * +----+    |     |      +----+
- * |    | ---+     +----> |    | ------> n-th element to be sorted
- * +----+                 +----+
- *
- * where the i-th element of the indirect array points to the element
- * that should be i-th in the sorted array.  After the sort phase,
- * we have to put the elements of list1 into the places
- * dictated by the indirect array.
- */
-
-
-static I32
-cmpindir(pTHX_ gptr const a, gptr const b)
-{
-    gptr * const ap = (gptr *)a;
-    gptr * const bp = (gptr *)b;
-    const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
-
-    if (sense)
-       return sense;
-    return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
-}
-
-static I32
-cmpindir_desc(pTHX_ gptr const a, gptr const b)
-{
-    gptr * const ap = (gptr *)a;
-    gptr * const bp = (gptr *)b;
-    const I32 sense = PL_sort_RealCmp(aTHX_ *ap, *bp);
-
-    /* Reverse the default */
-    if (sense)
-       return -sense;
-    /* But don't reverse the stability test.  */
-    return (ap > bp) ? 1 : ((ap < bp) ? -1 : 0);
-
-}
-
-STATIC void
-S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
-{
-    if ((flags & SORTf_STABLE) != 0) {
-        gptr **pp, *q;
-        size_t n, j, i;
-        gptr *small[SMALLSORT], **indir, tmp;
-        SVCOMPARE_t savecmp;
-        if (nmemb <= 1) return;     /* sorted trivially */
-
-        /* Small arrays can use the stack, big ones must be allocated */
-        if (nmemb <= SMALLSORT) indir = small;
-        else { Newx(indir, nmemb, gptr *); }
-
-        /* Copy pointers to original array elements into indirect array */
-        for (n = nmemb, pp = indir, q = list1; n--; ) *pp++ = q++;
-
-        savecmp = PL_sort_RealCmp;     /* Save current comparison routine, if any */
-        PL_sort_RealCmp = cmp; /* Put comparison routine where cmpindir can find it */
-
-        /* sort, with indirection */
-        if (flags & SORTf_DESC)
-           qsortsvu((gptr *)indir, nmemb, cmpindir_desc);
-       else
-           qsortsvu((gptr *)indir, nmemb, cmpindir);
-
-        pp = indir;
-        q = list1;
-        for (n = nmemb; n--; ) {
-             /* Assert A: all elements of q with index > n are already
-              * 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,
-              * so, by A, we never tamper with elements above n.
-              */
-             j = pp[n] - q;            /* This sets j so that q[j] is
-                                        * at pp[n].  *pp[j] belongs in
-                                        * q[j], by construction.
-                                        */
-             if (n != j) {             /* all's well if n == j */
-                  tmp = q[j];          /* save what's in q[j] */
-                  do {
-                       q[j] = *pp[j];  /* put *pp[j] where it belongs */
-                       i = pp[j] - q;  /* the index in q of the element
-                                        * just moved */
-                       pp[j] = q + j;  /* this is ok now */
-                  } while ((j = i) != n);
-                  /* There are only finitely many (nmemb) addresses
-                   * in the pp array.
-                   * So we must eventually revisit an index we saw before.
-                   * Suppose the first revisited index is k != n.
-                   * An index is visited because something else belongs there.
-                   * If we visit k twice, then two different elements must
-                   * belong in the same place, which cannot be.
-                   * So j must get back to n, the loop terminates,
-                   * and we put the saved element where it belongs.
-                   */
-                  q[n] = tmp;          /* put what belongs into
-                                        * the n-th element */
-             }
-        }
-
-       /* free iff allocated */
-        if (indir != small) { Safefree(indir); }
-        /* restore prevailing comparison routine */
-        PL_sort_RealCmp = savecmp;
-    } else if ((flags & SORTf_DESC) != 0) {
-        const SVCOMPARE_t savecmp = PL_sort_RealCmp;   /* Save current comparison routine, if any */
-        PL_sort_RealCmp = cmp; /* Put comparison routine where cmp_desc can find it */
-        cmp = cmp_desc;
-        qsortsvu(list1, nmemb, cmp);
-        /* restore prevailing comparison routine */
-        PL_sort_RealCmp = savecmp;
-    } else {
-        qsortsvu(list1, nmemb, cmp);
-    }
-}
-
 /*
 =head1 Array Manipulation Functions
 
@@ -1445,25 +789,6 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp)
     sortsv_flags(array, nmemb, cmp, 0);
 }
 
-/*
-=for apidoc sortsv_flags
-
-In-place sort an array of SV pointers with the given comparison routine,
-with various SORTf_* flag options.
-
-=cut
-*/
-void
-Perl_sortsv_flags(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags)
-{
-    PERL_ARGS_ASSERT_SORTSV_FLAGS;
-
-    if (flags & SORTf_QSORT)
-       S_qsortsv(aTHX_ array, nmemb, cmp, flags);
-    else
-       S_mergesortsv(aTHX_ array, nmemb, cmp, flags);
-}
-
 #define SvNSIOK(sv) ((SvFLAGS(sv) & SVf_NOK) || ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK))
 #define SvSIOK(sv) ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV)) == SVf_IOK)
 #define SvNSIV(sv) ( SvNOK(sv) ? SvNVX(sv) : ( SvSIOK(sv) ? SvIVX(sv) : sv_2nv(sv) ) )
@@ -1491,8 +816,6 @@ PP(pp_sort)
 
     if ((priv & OPpSORT_DESCEND) != 0)
        sort_flags |= SORTf_DESC;
-    if ((priv & OPpSORT_QSORT) != 0)
-       sort_flags |= SORTf_QSORT;
     if ((priv & OPpSORT_STABLE) != 0)
        sort_flags |= SORTf_STABLE;
     if ((priv & OPpSORT_UNSTABLE) != 0)
diff --git a/proto.h b/proto.h
index 8c58a08..94009ac 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -5042,9 +5042,6 @@ STATIC I32        S_amagic_i_ncmp(pTHX_ SV *const a, SV *const b);
 STATIC I32     S_amagic_ncmp(pTHX_ SV *const a, SV *const b);
 #define PERL_ARGS_ASSERT_AMAGIC_NCMP   \
        assert(a); assert(b)
-STATIC void    S_qsortsvu(pTHX_ SV** array, size_t num_elts, SVCOMPARE_t compare);
-#define PERL_ARGS_ASSERT_QSORTSVU      \
-       assert(compare)
 STATIC I32     S_sortcv(pTHX_ SV *const a, SV *const b);
 #define PERL_ARGS_ASSERT_SORTCV        \
        assert(a); assert(b)
index d9082e7..e0a27f6 100644 (file)
@@ -671,7 +671,6 @@ addbits('sort',
     2 => qw(OPpSORT_REVERSE  REV    ), # Reversed sort
     3 => qw(OPpSORT_INPLACE  INPLACE), # sort in-place; eg @a = sort @a
     4 => qw(OPpSORT_DESCEND  DESC   ), # Descending sort
-    5 => qw(OPpSORT_QSORT    QSORT  ), # Use quicksort (not mergesort)
     6 => qw(OPpSORT_STABLE   STABLE ), # Use a stable algorithm
     7 => qw(OPpSORT_UNSTABLE UNSTABLE),# Use an unstable algorithm
 );