From: Vincent Pit Date: Tue, 10 Nov 2009 21:33:29 +0000 (+0100) Subject: Optimize reversing an array in-place X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=484c818fbcf400d897228be2cf2b34b67be8a340;p=p5sagit%2Fp5-mst-13.2.git Optimize reversing an array in-place --- diff --git a/ext/B/B/Concise.pm b/ext/B/B/Concise.pm index 671212d..2699605 100644 --- a/ext/B/B/Concise.pm +++ b/ext/B/B/Concise.pm @@ -634,6 +634,7 @@ $priv{"list"}{64} = "GUESSED"; $priv{"delete"}{64} = "SLICE"; $priv{"exists"}{64} = "SUB"; @{$priv{"sort"}}{1,2,4,8,16,32,64} = ("NUM", "INT", "REV", "INPLACE","DESC","QSORT","STABLE"); +$priv{"reverse"}{8} = "INPLACE"; $priv{"threadsv"}{64} = "SVREFd"; @{$priv{$_}}{16,32,64,128} = ("INBIN","INCR","OUTBIN","OUTCR") for ("open", "backtick"); diff --git a/op.c b/op.c index e870a57..58b2508 100644 --- a/op.c +++ b/op.c @@ -8892,8 +8892,36 @@ Perl_peep(pTHX_ register OP *o) case OP_REVERSE: { OP *ourmark, *theirmark, *ourlast, *iter, *expushmark, *rv2av; OP *gvop = NULL; + OP *oleft, *oright; LISTOP *enter, *exlist; + /* @a = reverse @a */ + if ((oright = cLISTOPo->op_first) + && (oright->op_type == OP_PUSHMARK) + && (oright = oright->op_sibling) + && (oleft = is_inplace_av(o, oright))) { + OP *o2; + + /* transfer MODishness etc from LHS arg to RHS arg */ + oright->op_flags = oleft->op_flags; + o->op_private |= OPpREVERSE_INPLACE; + + /* excise push->gv->rv2av->null->aassign */ + o2 = o->op_next->op_next; + op_null(o2); /* PUSHMARK */ + o2 = o2->op_next; + if (o2->op_type == OP_GV) { + op_null(o2); /* GV */ + o2 = o2->op_next; + } + op_null(o2); /* RV2AV or PADAV */ + o2 = o2->op_next->op_next; + op_null(o2); /* AASSIGN */ + + o->op_next = o2->op_next; + break; + } + enter = (LISTOP *) o->op_next; if (!enter) break; diff --git a/op.h b/op.h index 9608564..25b59ea 100644 --- a/op.h +++ b/op.h @@ -258,6 +258,9 @@ Deprecated. Use C instead. #define OPpSORT_QSORT 32 /* Use quicksort (not mergesort) */ #define OPpSORT_STABLE 64 /* Use a stable algorithm */ +/* Private for OP_REVERSE */ +#define OPpREVERSE_INPLACE 8 /* reverse in-place (@a = reverse @a) */ + /* Private for OP_OPEN and OP_BACKTICK */ #define OPpOPEN_IN_RAW 16 /* binmode(F,":raw") on input fh */ #define OPpOPEN_IN_CRLF 32 /* binmode(F,":crlf") on input fh */ diff --git a/pod/perl5112delta.pod b/pod/perl5112delta.pod index d6dad5d..0fed626 100644 --- a/pod/perl5112delta.pod +++ b/pod/perl5112delta.pod @@ -162,14 +162,12 @@ Any changes to F should go in L. =head1 Performance Enhancements -XXX Changes which enhance performance without changing behaviour go here. There -may well be none in a stable release. - =over 4 =item * -XXX +Reversing an array in-place in void context is now several orders of magnitude faster than it used to be. +It will also preserve non-existent elements whenever possible, i.e. for non magical arrays or tied arrays with C and C methods. =back diff --git a/pp.c b/pp.c index 86d79fb..67a2d11 100644 --- a/pp.c +++ b/pp.c @@ -4791,17 +4791,76 @@ PP(pp_unshift) PP(pp_reverse) { dVAR; dSP; dMARK; - SV ** const oldsp = SP; if (GIMME == G_ARRAY) { - MARK++; - while (MARK < SP) { - register SV * const tmp = *MARK; - *MARK++ = *SP; - *SP-- = tmp; + if (PL_op->op_private & OPpREVERSE_INPLACE) { + AV *av; + + /* See pp_sort() */ + assert( MARK+1 == SP && *SP && SvTYPE(*SP) == SVt_PVAV); + (void)POPMARK; /* remove mark associated with ex-OP_AASSIGN */ + av = MUTABLE_AV((*SP)); + /* In-place reversing only happens in void context for the array + * assignment. We don't need to push anything on the stack. */ + SP = MARK; + + if (SvMAGICAL(av)) { + I32 i, j; + register SV *tmp = sv_newmortal(); + /* For SvCANEXISTDELETE */ + HV *stash; + const MAGIC *mg; + bool can_preserve = SvCANEXISTDELETE(av); + + for (i = 0, j = av_len(av); i < j; ++i, --j) { + register SV *begin, *end; + + if (can_preserve) { + if (!av_exists(av, i)) { + if (av_exists(av, j)) { + register SV *sv = av_delete(av, j, 0); + begin = *av_fetch(av, i, TRUE); + sv_setsv_mg(begin, sv); + } + continue; + } + else if (!av_exists(av, j)) { + register SV *sv = av_delete(av, i, 0); + end = *av_fetch(av, j, TRUE); + sv_setsv_mg(end, sv); + continue; + } + } + + begin = *av_fetch(av, i, TRUE); + end = *av_fetch(av, j, TRUE); + sv_setsv(tmp, begin); + sv_setsv_mg(begin, end); + sv_setsv_mg(end, tmp); + } + } + else { + SV **begin = AvARRAY(av); + SV **end = begin + AvFILLp(av); + + while (begin < end) { + register SV * const tmp = *begin; + *begin++ = *end; + *end-- = tmp; + } + } + } + else { + SV **oldsp = SP; + MARK++; + while (MARK < SP) { + register SV * const tmp = *MARK; + *MARK++ = *SP; + *SP-- = tmp; + } + /* safe as long as stack cannot get extended in the above */ + SP = oldsp; } - /* safe as long as stack cannot get extended in the above */ - SP = oldsp; } else { register char *up; diff --git a/t/op/reverse.t b/t/op/reverse.t index 7afaac7..1ad727a 100644 --- a/t/op/reverse.t +++ b/t/op/reverse.t @@ -6,7 +6,7 @@ BEGIN { require './test.pl'; } -plan tests => 5; +plan tests => 21; is(reverse("abc"), "cba"); @@ -22,6 +22,60 @@ is(reverse(), "raboof"); } { + my @a = (1, 2, 3, 4); + @a = reverse @a; + is("@a", "4 3 2 1"); + + delete $a[1]; + @a = reverse @a; + ok(!exists $a[2]); + is($a[0] . $a[1] . $a[3], '124'); + + @a = (5, 6, 7, 8, 9); + @a = reverse @a; + is("@a", "9 8 7 6 5"); + + delete $a[3]; + @a = reverse @a; + ok(!exists $a[1]); + is($a[0] . $a[2] . $a[3] . $a[4], '5789'); + + delete $a[2]; + @a = reverse @a; + ok(!exists $a[2] && !exists $a[3]); + is($a[0] . $a[1] . $a[4], '985'); +} + +use Tie::Array; + +{ + tie my @a, 'Tie::StdArray'; + + @a = (1, 2, 3, 4); + @a = reverse @a; + is("@a", "4 3 2 1"); + + delete $a[1]; + @a = reverse @a; + ok(!exists $a[2]); + is($a[0] . $a[1] . $a[3], '124'); + + @a = (5, 6, 7, 8, 9); + @a = reverse @a; + is("@a", "9 8 7 6 5"); + + delete $a[3]; + @a = reverse @a; + ok(!exists $a[1]); + is($a[0] . $a[2] . $a[3] . $a[4], '5789'); + + delete $a[2]; + @a = reverse @a; + ok(!exists $a[2] && !exists $a[3]); + is($a[0] . $a[1] . $a[4], '985'); +} + +{ # Unicode. my $a = "\x{263A}\x{263A}x\x{263A}y\x{263A}";