re-implement OPpASSIGN_COMMON mechanism

This commit almost completely replaces the current mechanism
for detecting and handing common vars in list assignment, e.g.

    ($a,$b) = ($b,$a);

In general outline: it creates more false positives at compile-time
than before, but also no longer misses some false negatives. In
compensation, it considerably reduces the run-time cost of handling
potential and real commonality.

It does this firstly by splitting the OPpASSIGN_COMMON flag into 3
separate flags:

    OPpASSIGN_COMMON_AGG
    OPpASSIGN_COMMON_RC1
    OPpASSIGN_COMMON_SCALAR

which indicate different classes of commonality that can be handled
in different ways at runtime.

Most importantly, it distinguishes between two basic cases. Firstly,
common scalars (OPpASSIGN_COMMON_SCALAR), e.g.

    ($x,....) = (....,$x,...)

where $x is modified and then sometime later its value is used again,
but that value has changed in the meantime. In this case, we need
replace such vars on the RHS with mortal copies before processing the
assign.

The second case is an aggregate on the LHS (OPpASSIGN_COMMON_AGG), e.g.

    (...,@a) = (...., $a[0],...)

In this case, the issue is instead that when @a is cleared, it may free
items on the RHS (due to the stack not being ref counted).  What is
required here is that rather than making of a copy of each RHS element and
storing it in the array as we progress, we make *all* the copies *before*
clearing the array, but mortalise them in case we die in the meantime.

We can further distinguish two scalar cases; sometimes it's possible
to confirm non-commonality at run-time merely by checking that all
the LHS scalars have a reference count of 1. If this is possible,
we set the OPpASSIGN_COMMON_RC1 flag rather than the
OPpASSIGN_COMMON_SCALAR flag.

The major improvement in the run-time performance in the
OPpASSIGN_COMMON_SCALAR case (or OPpASSIGN_COMMON_RC1 if rc>1 scalars are
detected), is to use a mark-and-sweep scan of the two lists using the
SVf_BREAK flag, to determine which elements are common, and only make
mortal copies of those elements.  This has a very big effect on run-time
performance; for example in the classic

    ($a,$b) = ($b,$a);

it would formerly make temp copies of both $a and $b; now it only
copies $a.

In more detail, the mark and sweep mechanism in pp_aassign works by
looping through each LHS and RHS SV pair in parallel. It temporarily marks
each LHS SV with the SVf_BREAK flag, then makes a copy of each RHS element
only if it has the SVf_BREAK flag set. When the scan is finished, the flag
is unset on all LHS elements.

One major change in compile-time flagging is that package scalar vars are
now treated as if they could always be aliased. So we don't bother any
more to do the compile-time PL_generation checking on package vars (we
still do it on lexical vars). We also no longer make use of the run-time
PL_sawalias mechanism for detecting aliased package vars (and indeed the
next commit but one will remove that mechanism). This means that more list
assignment expressions which feature package vars will now need to
do a runtime mark-and-sweep (or where appropriate, RC1) test. In
compensation, we no longer need to test for aliasing and set PL_sawalias
in pp_gvsv and pp_gv, nor reset PL_sawalias in every pp_nextstate.

Part of the reasoning behind this is that it's nearly impossible to detect
all possible package var aliasing; for example PL_sawalias would fail to
detect XS code doing GvSV(gv) = sv.

Note that we now scan the two children of the OP_AASSIGN separately,
and in particular we mark lexicals with PL_generation only on the
LHS and test only on the RHS. So something like

    ($x,$y) = ($default, $default)

will no longer be regarded as having common vars.

In terms of performance, running Porting/perlbench.pl on the new
expr::aassign:: tests in t/perf/benchmarks show that the biggest slowdown
is around 13% more instruction reads and 20% more conditional branches in
this:
        setup   => 'my ($v1,$v2,$v3) = 1..3; ($x,$y,$z) = 1..3;',
        code    => '($x,$y,$z) = ($v1,$v2,$v3)',

where this is now a false positive due to the presence of package
variables.

The biggest speedup is 50% less instruction reads and conditional branches
in this:

        setup   => '@_ = 1..3; my ($x,$y,$z)',
        code    => '($x,$y,$z) = @_',

because formerly the presence of @_ pessimised things if the LHS wasn't
a my declaration (it's still pessimised, but the runtime's faster now).

Conversely, we pessimise the 'my' variant too now:

        setup   => '@_ = 1..3;',
        code    => 'my ($x,$y,$z) = @_',

this gives 5% more instruction reads and 11% more conditional branches now.
But see the next commit, which will cheat for that particular construct.

1 files changed, 265 insertions, 0 deletions

diff --git a/t/op/aassign.t b/t/op/aassign.t
new file mode 100644
index 0000000000..622053c004
--- /dev/null
+++ b/t/op/aassign.t
@@ -0,0 +1,265 @@
+#!./perl -w
+
+# Some miscellaneous checks for the list assignment operator, OP_AASSIGN.
+#
+# This file was only added in 2015; before then, such tests were
+# typically in various other random places like op/array.t. This test file
+# doesn't therefore attempt to be comprehensive; it merely provides a
+# central place to new put additional tests, especially those related to
+# the trickiness of commonality, e.g. ($a,$b) = ($b,$a).
+#
+# In particular, it's testing the flags
+#    OPpASSIGN_COMMON_SCALAR
+#    OPpASSIGN_COMMON_RC1
+#    OPpASSIGN_COMMON_AGG
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require './test.pl';
+}
+
+use warnings;
+use strict;
+
+# general purpose package vars
+
+our $pkg_scalar;
+our @pkg_array;
+our %pkg_hash;
+
+sub f_ret_14 { return 1..4 }
+
+# stringify a hash ref
+
+sub sh {
+    my $rh = $_[0];
+    join ',', map "$_:$rh->{$_}", sort keys %$rh;
+}
+
+
+# where the RHS has surplus elements
+
+{
+    my ($a,$b);
+    ($a,$b) = f_ret_14();
+    is("$a:$b", "1:2", "surplus");
+}
+
+# common with slices
+
+{
+    my @a = (1,2);
+    @a[0,1] = @a[1,0];
+    is("$a[0]:$a[1]", "2:1", "lex array slice");
+}
+
+# package alias
+
+{
+    my ($a, $b) = 1..2;
+    for $pkg_scalar ($a) {
+        ($pkg_scalar, $b) = (3, $a);
+        is($pkg_scalar, 3, "package alias pkg");
+        is("$a:$b", "3:1", "package alias a:b");
+    }
+}
+
+# my array/hash populated via closure
+
+{
+    my $ra = f1();
+    my ($x, @a) = @$ra;
+    sub f1 { $x = 1; @a = 2..4; \@a }
+    is($x,       2, "my: array closure x");
+    is("@a", "3 4", "my: array closure a");
+
+    my $rh = f2();
+    my ($k, $v, %h) = (d => 4, %$rh, e => 6);
+    sub f2 { $k = 'a'; $v = 1; %h = qw(b 2 c 3); \%h }
+    is("$k:$v", "d:4", "my: hash closure k:v");
+    is(sh(\%h), "b:2,c:3,e:6", "my: hash closure h");
+}
+
+
+# various shared element scenarios within a my (...)
+
+{
+    my ($x,$y) = f3(); # $x and $y on both sides
+    sub f3 : lvalue { ($x,$y) = (1,2); $y, $x }
+    is ("$x:$y", "2:1", "my: scalar and lvalue sub");
+}
+
+{
+    my $ra = f4();
+    my @a = @$ra;  # elements of @a on both sides
+    sub f4 { @a = 1..4; \@a }
+    is("@a", "1 2 3 4", "my: array and elements");
+}
+
+{
+    my $rh = f5();
+    my %h = %$rh;  # elements of %h on both sides
+    sub f5 { %h = qw(a 1 b 2 c 3); \%h }
+    is(sh(\%h), "a:1,b:2,c:3", "my: hash and elements");
+}
+
+{
+    f6();
+    our $xalias6;
+    my ($x, $y) = (2, $xalias6);
+    sub f6 { $x = 1; *xalias6 = \$x; }
+    is ("$x:$y", "2:1", "my: pkg var aliased to lexical");
+}
+
+
+{
+    my @a;
+    f7();
+    my ($x,$y) = @a;
+    is ("$x:$y", "2:1", "my: lex array elements aliased");
+
+    sub f7 {
+        ($x, $y) = (1,2);
+        use feature 'refaliasing';
+        no warnings 'experimental';
+        \($a[0], $a[1]) = \($y,$x);
+    }
+}
+
+{
+    @pkg_array = ();
+    f8();
+    my ($x,$y) = @pkg_array;
+    is ("$x:$y", "2:1", "my: pkg array elements aliased");
+
+    sub f8 {
+        ($x, $y) = (1,2);
+        use feature 'refaliasing';
+        no warnings 'experimental';
+        \($pkg_array[0], $pkg_array[1]) = \($y,$x);
+    }
+}
+
+{
+    f9();
+    my ($x,$y) = f9();
+    is ("$x:$y", "2:1", "my: pkg scalar alias");
+
+    our $xalias9;
+    sub f9 : lvalue {
+        ($x, $y) = (1,2);
+        *xalias9 = \$x;
+        $y, $xalias9;
+    }
+}
+
+{
+    use feature 'refaliasing';
+    no warnings 'experimental';
+
+    f10();
+    our $pkg10;
+    \(my $lex) = \$pkg10;
+    my @a = ($lex,3); # equivalent to ($a[0],3)
+    is("@a", "1 3", "my: lex alias of array alement");
+
+    sub f10 {
+        @a = (1,2);
+        \$pkg10 = \$a[0];
+    }
+
+}
+
+{
+    use feature 'refaliasing';
+    no warnings 'experimental';
+
+    f11();
+    my @b;
+    my @a = (@b);
+    is("@a", "2 1", "my: lex alias of array alements");
+
+    sub f11 {
+        @a = (1,2);
+        \$b[0] = \$a[1];
+        \$b[1] = \$a[0];
+    }
+}
+
+# package aliasing
+
+{
+    my ($x, $y) = (1,2);
+
+    for $pkg_scalar ($x) {
+        ($pkg_scalar, $y) = (3, $x);
+        is("$pkg_scalar,$y", "3,1", "package scalar aliased");
+    }
+}
+
+# lvalue subs on LHS
+
+{
+    my @a;
+    sub f12 : lvalue { @a }
+    (f12()) = 1..3;
+    is("@a", "1 2 3", "lvalue sub on RHS returns array");
+}
+
+{
+    my ($x,$y);
+    sub f13 : lvalue { $x,$y }
+    (f13()) = 1..3;
+    is("$x:$y", "1:2", "lvalue sub on RHS returns scalars");
+}
+
+
+# package shared scalar vars
+
+{
+    our $pkg14a = 1;
+    our $pkg14b = 2;
+    ($pkg14a,$pkg14b) = ($pkg14b,$pkg14a);
+    is("$pkg14a:$pkg14b", "2:1", "shared package scalars");
+}
+
+# lexical shared scalar vars
+
+{
+    my $a = 1;
+    my $b = 2;
+    ($a,$b) = ($b,$a);
+    is("$a:$b", "2:1", "shared lexical scalars");
+}
+
+
+# lexical nested array elem swap
+
+{
+    my @a;
+    $a[0][0] = 1;
+    $a[0][1] = 2;
+    ($a[0][0],$a[0][1]) =  ($a[0][1],$a[0][0]);
+    is("$a[0][0]:$a[0][1]", "2:1", "lexical nested array elem swap");
+}
+
+# package nested array elem swap
+
+{
+    our @a15;
+    $a15[0][0] = 1;
+    $a15[0][1] = 2;
+    ($a15[0][0],$a15[0][1]) =  ($a15[0][1],$a15[0][0]);
+    is("$a15[0][0]:$a15[0][1]", "2:1", "package nested array elem swap");
+}
+
+# surplus RHS junk
+#
+{
+    our ($a16, $b16);
+    ($a16, undef, $b16) = 1..30;
+    is("$a16:$b16", "1:3", "surplus RHS junk");
+}
+
+done_testing();