From: Nicholas Clark Date: Tue, 13 Jul 2004 14:06:36 +0000 (+0000) Subject: A proper, working, stable optimisation for sort {$b cmp $a} X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=6c3fb703f2b4baeb80013bb4dcb062d7252ba482;p=p5sagit%2Fp5-mst-13.2.git A proper, working, stable optimisation for sort {$b cmp $a} p4raw-id: //depot/perl@23096 --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index eb9398a..ebd5848 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -14,7 +14,7 @@ use warnings; # uses #3 and #4, since warnings uses Carp use Exporter (); # use #5 -our $VERSION = "0.62"; +our $VERSION = "0.63"; our @ISA = qw(Exporter); our @EXPORT_OK = qw( set_style set_style_standard add_callback concise_subref concise_cv concise_main @@ -554,7 +554,7 @@ $priv{"exists"}{64} = "SUB"; $priv{$_}{64} = "LOCALE" for ("sort", "prtf", "sprintf", "slt", "sle", "seq", "sne", "sgt", "sge", "scmp", "lc", "uc", "lcfirst", "ucfirst"); -@{$priv{"sort"}}{1,2,4,8} = ("NUM", "INT", "REV", "INPLACE"); +@{$priv{"sort"}}{1,2,4,8,16} = ("NUM", "INT", "REV", "INPLACE","DESC"); $priv{"threadsv"}{64} = "SVREFd"; @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR") for ("open", "backtick"); diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t index f3eec35..377b41c 100644 --- a/ext/B/t/f_sort.t +++ b/ext/B/t/f_sort.t @@ -154,11 +154,11 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*files] s # 5 <1> rv2av[t7] lK/1 -# 6 <@> sort lKS* +# 6 <@> sort lK/DESC # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t8] KS +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -166,11 +166,11 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*files) s # 5 <1> rv2av[t3] lK/1 -# 6 <@> sort lKS* +# 6 <@> sort lK/DESC # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t4] KS +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT @@ -228,11 +228,11 @@ checkOptree(note => q{}, # 3 <0> pushmark s # 4 <#> gv[*files] s # 5 <1> rv2av[t7] lK/1 -# 6 <@> sort lKS* +# 6 <@> sort lK/DESC,NUM # 7 <0> pushmark s # 8 <#> gv[*articles] s # 9 <1> rv2av[t2] lKRM*/1 -# a <2> aassign[t8] KS +# a <2> aassign[t5] KS # b <1> leavesub[1 ref] K/REFC,1 EOT_EOT # 1 <;> nextstate(main 546 (eval 15):1) v @@ -240,11 +240,11 @@ EOT_EOT # 3 <0> pushmark s # 4 <$> gv(*files) s # 5 <1> rv2av[t3] lK/1 -# 6 <@> sort lKS* +# 6 <@> sort lK/DESC,NUM # 7 <0> pushmark s # 8 <$> gv(*articles) s # 9 <1> rv2av[t1] lKRM*/1 -# a <2> aassign[t4] KS +# a <2> aassign[t2] KS # b <1> leavesub[1 ref] K/REFC,1 EONT_EONT diff --git a/op.c b/op.c index 940d802..fd1e492 100644 --- a/op.c +++ b/op.c @@ -5948,10 +5948,6 @@ S_simplify_sort(pTHX_ OP *o) else return; - /* FIXME once we have proper descending support in pp_sort */ - if (descending) - return; - kid = k; /* back to cmp */ if (kBINOP->op_last->op_type != OP_RV2SV) return; diff --git a/pp_sort.c b/pp_sort.c index 8d7f48f..b07eea6 100644 --- a/pp_sort.c +++ b/pp_sort.c @@ -335,8 +335,15 @@ typedef struct { IV runs; /* how many runs must be combined into 1 */ } off_runs; /* pseudo-stack element */ + +static I32 +cmp_desc(pTHX_ gptr a, gptr b) +{ + return -PL_sort_RealCmp(aTHX_ a, b); +} + STATIC void -S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp) +S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { IV i, run, runs, offset; I32 sense, level; @@ -347,8 +354,16 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp) gptr small[SMALLSORT]; gptr *which[3]; off_runs stack[60], *stackp; + SVCOMPARE_t savecmp; if (nmemb <= 1) return; /* sorted trivially */ + + if (flags) { + 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; + } + if (nmemb <= SMALLSORT) aux = small; /* use stack for aux array */ else { New(799,aux,nmemb,gptr); } /* allocate auxilliary array */ level = 0; @@ -531,6 +546,9 @@ S_mergesortsv(pTHX_ gptr *base, size_t nmemb, SVCOMPARE_t cmp) } done: if (aux != small) Safefree(aux); /* free iff allocated */ + if (flags) { + PL_sort_RealCmp = savecmp; /* Restore current comparison routine, if any */ + } return; } @@ -1300,8 +1318,23 @@ cmpindir(pTHX_ gptr a, gptr b) return sense; } +static I32 +cmpindir_desc(pTHX_ gptr a, gptr b) +{ + I32 sense; + gptr *ap = (gptr *)a; + gptr *bp = (gptr *)b; + + /* Reverse the default */ + if ((sense = PL_sort_RealCmp(aTHX_ *ap, *bp))) + 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) +S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp, U32 flags) { SV *hintsv; @@ -1323,7 +1356,8 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) PL_sort_RealCmp = cmp; /* Put comparison routine where cmpindir can find it */ /* sort, with indirection */ - S_qsortsvu(aTHX_ (gptr *)indir, nmemb, cmpindir); + S_qsortsvu(aTHX_ (gptr *)indir, nmemb, + flags ? cmpindir_desc : cmpindir); pp = indir; q = list1; @@ -1366,6 +1400,13 @@ S_qsortsv(pTHX_ gptr *list1, size_t nmemb, SVCOMPARE_t cmp) if (indir != small) { Safefree(indir); } /* restore prevailing comparison routine */ PL_sort_RealCmp = savecmp; + } else if (flags) { + 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; + S_qsortsvu(aTHX_ list1, nmemb, cmp); + /* restore prevailing comparison routine */ + PL_sort_RealCmp = savecmp; } else { S_qsortsvu(aTHX_ list1, nmemb, cmp); } @@ -1388,8 +1429,8 @@ See lib/sort.pm for details about controlling the sorting algorithm. void Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) { - void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) = - S_mergesortsv; + void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) + = S_mergesortsv; SV *hintsv; I32 hints; @@ -1407,7 +1448,33 @@ Perl_sortsv(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) sortsvp = S_mergesortsv; } - sortsvp(aTHX_ array, nmemb, cmp); + sortsvp(aTHX_ array, nmemb, cmp, 0); +} + + +void +S_sortsv_desc(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) +{ + void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp, U32 flags) + = S_mergesortsv; + SV *hintsv; + I32 hints; + + /* Sun's Compiler (cc: WorkShop Compilers 4.2 30 Oct 1996 C 4.2) used + to miscompile this function under optimization -O. If you get test + errors related to picking the correct sort() function, try recompiling + this file without optimiziation. -- A.D. 4/2002. + */ + hints = SORTHINTS(hintsv); + if (hints & HINT_SORT_QUICKSORT) { + sortsvp = S_qsortsv; + } + else { + /* The default as of 5.8.0 is mergesort */ + sortsvp = S_mergesortsv; + } + + sortsvp(aTHX_ array, nmemb, cmp, 1); } PP(pp_sort) @@ -1425,6 +1492,8 @@ PP(pp_sort) bool hasargs = FALSE; I32 is_xsub = 0; I32 sorting_av = 0; + void (*sortsvp)(pTHX_ SV **array, size_t nmemb, SVCOMPARE_t cmp) + = Perl_sortsv; if (gimme != G_ARRAY) { SP = MARK; @@ -1507,6 +1576,10 @@ PP(pp_sort) max = SP - MARK; } + if (PL_op->op_private & OPpSORT_DESCEND) { + sortsvp = S_sortsv_desc; + } + /* shuffle stack down, removing optional initial cv (p1!=p2), plus any * nulls; also stringify any args */ for (i=max; i > 0 ; i--) { @@ -1567,8 +1640,8 @@ PP(pp_sort) CX_CURPAD_SAVE(cx->blk_sub); cx->blk_sub.argarray = av; } - sortsv(p1-max, max, - is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); + sortsvp(aTHX_ p1-max, max, + is_xsub ? sortcv_xsub : hasargs ? sortcv_stacked : sortcv); POPBLOCK(cx,PL_curpm); PL_stack_sp = newsp; @@ -1577,8 +1650,8 @@ PP(pp_sort) } else { MEXTEND(SP, 20); /* Can't afford stack realloc on signal. */ - sortsv(sorting_av ? AvARRAY(av) : ORIGMARK+1, max, - (PL_op->op_private & OPpSORT_NUMERIC) + sortsvp(aTHX_ sorting_av ? AvARRAY(av) : ORIGMARK+1, max, + (PL_op->op_private & OPpSORT_NUMERIC) ? ( (PL_op->op_private & OPpSORT_INTEGER) ? ( overloading ? amagic_i_ncmp : sv_i_ncmp) : ( overloading ? amagic_ncmp : sv_ncmp))