summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorZefram <zefram@fysh.org>2017-11-17 05:28:21 +0000
committerZefram <zefram@fysh.org>2017-11-17 05:33:04 +0000
commite2091bb6ea87111c32936c9170405a44995be338 (patch)
treee9ab2b9a7f868e702981a6c725419504391d28c1
parent73d689df0b635676359707f9eaa2ce012ada9fd7 (diff)
downloadperl-e2091bb6ea87111c32936c9170405a44995be338.tar.gz
rip out quicksort and sort algorithm control
[perl #119635]
-rw-r--r--embed.fnc1
-rw-r--r--embed.h1
-rw-r--r--ext/B/t/f_sort4
-rw-r--r--ext/B/t/f_sort.t40
-rw-r--r--lib/B/Op_private.pm5
-rw-r--r--lib/sort.pm73
-rw-r--r--lib/sort.t41
-rw-r--r--op.c2
-rw-r--r--opcode.h206
-rw-r--r--perl.h3
-rw-r--r--pod/perldelta.pod12
-rw-r--r--pod/perlfunc.pod26
-rw-r--r--pod/perlsec.pod2
-rw-r--r--pp_sort.c699
-rw-r--r--proto.h3
-rw-r--r--regen/op_private1
16 files changed, 152 insertions, 967 deletions
diff --git a/embed.fnc b/embed.fnc
index 52bb84871d..c33833a53a 100644
--- 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 2c047fb6d8..13277fc40c 100644
--- a/embed.h
+++ b/embed.h
@@ -1760,7 +1760,6 @@
#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)
diff --git a/ext/B/t/f_sort b/ext/B/t/f_sort
index 759523bb70..75e8f10596 100644
--- a/ext/B/t/f_sort
+++ b/ext/B/t/f_sort
@@ -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;
diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t
index ccee813fc8..24a9f2e38c 100644
--- a/ext/B/t/f_sort.t
+++ b/ext/B/t/f_sort.t
@@ -13,7 +13,7 @@ BEGIN {
}
}
use OptreeCheck;
-plan tests => 40;
+plan tests => 38;
=head1 f_sort.t
@@ -681,44 +681,6 @@ checkOptree(note => q{},
=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!
@articles = sort {$FooPack::b <=> $FooPack::a} @files;
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index 6c9840e9bc..aaac03a372 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -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};
diff --git a/lib/sort.pm b/lib/sort.pm
index 99d9f0b04c..659f3e4f4d 100644
--- a/lib/sort.pm
+++ b/lib/sort.pm
@@ -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";
diff --git a/lib/sort.t b/lib/sort.t
index 1ff3832f95..e0ef9d3fac 100644
--- a/lib/sort.t
+++ b/lib/sort.t
@@ -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,49 +142,20 @@ 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(); }
is($sort_current, 'stable', 'sort::current after defaults stable');
diff --git a/op.c b/op.c
index 2e4dae43c6..c8b43f7773 100644
--- 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)
diff --git a/opcode.h b/opcode.h
index 10e68168de..b5ed37ff35 100644
--- 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 23f209c013..b6d3a3e639 100644
--- 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
diff --git a/pod/perldelta.pod b/pod/perldelta.pod
index 03d545cbe7..9f2abcffc2 100644
--- a/pod/perldelta.pod
+++ b/pod/perldelta.pod
@@ -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.
diff --git a/pod/perlfunc.pod b/pod/perlfunc.pod
index 5cced5a5cf..ee8ec3d9f2 100644
--- a/pod/perlfunc.pod
+++ b/pod/perlfunc.pod
@@ -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
diff --git a/pod/perlsec.pod b/pod/perlsec.pod
index 3635ec3e4d..ab126f753e 100644
--- a/pod/perlsec.pod
+++ b/pod/perlsec.pod
@@ -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.
diff --git a/pp_sort.c b/pp_sort.c
index 9d31bdafe0..fb4e2f8b8e 100644
--- 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 8c58a086bb..94009acac6 100644
--- 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)
diff --git a/regen/op_private b/regen/op_private
index d9082e7709..e0a27f6d75 100644
--- a/regen/op_private
+++ b/regen/op_private
@@ -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
);