In perl.git, the branch blead has been updated

<http://perl5.git.perl.org/perl.git/commitdiff/fba30c6930fff718653b59c3aedac3438defabe3?hp=0ba9d88c925494ce5e0e96d4ea3c11637807f08c>

- Log -----------------------------------------------------------------
commit fba30c6930fff718653b59c3aedac3438defabe3
Merge: 0ba9d88 8c1e192
Author: David Mitchell <[email protected]>
Date:   Mon Aug 17 11:17:01 2015 +0100

    [MERGE] re-implement OPpASSIGN_COMMON mechanism

commit 8c1e192faf1bea909b6379b9cc795ad3cfffd43c
Author: David Mitchell <[email protected]>
Date:   Fri Aug 14 09:23:59 2015 +0100

    fix a SV_NOSTEAL issue in pp_aassign
    
    in something like (...) = (f())[0,0]
    
    A mortal SV can appear multiple times on the RHS without being reference
    counted. If it's a string, the temptation is to steal its string buffer
    during the first copy; but this would make the second usage undef.
    
    pp_aassign() already takes account of this and uses the SV_NOSTEAL
    flag when copying - except that one common code path didn't.
    
    This commit fixes that, adds more tests, and adds more code comments
    to explain the issue.

M       pp_hot.c
M       t/op/aassign.t

commit e25bbd9e44d1b7c890627ba5e609923ad626f9c9
Author: David Mitchell <[email protected]>
Date:   Thu Aug 13 12:26:06 2015 +0100

    fix PAD_COMPNAME_GEN documentation
    
    The generation number is no longer stored in the SvUVX() field

M       pad.h

commit 750107042ee9a8457cb47e6713ffa0e7d8313c23
Author: David Mitchell <[email protected]>
Date:   Thu Aug 13 12:21:54 2015 +0100

    document what PL_generation is for

M       intrpvar.h

commit 7ede59473c4d7a55acad865d53265f59b4a6c628
Author: David Mitchell <[email protected]>
Date:   Thu Aug 13 12:07:38 2015 +0100

    Eliminate GvASSIGN_GENERATION and _set macros
    
    Since we no longer scan package vars with PL_generation for
    OPpASSIGN_COMMON* purposes, eliminate the macros used for that purpose.

M       gv.h

commit 808ce55782035154ec42358256dbec2e226977fe
Author: David Mitchell <[email protected]>
Date:   Thu Aug 13 17:00:32 2015 +0100

    Optimise 1 arg in list assign
    
    Avoid setting common scalar flags in these cases:
    
    ($x) = (...);
    (...) = ($x);

M       op.c
M       t/op/aassign.t
M       t/perf/benchmarks
M       t/perf/optree.t

commit 71afaecef1b2593c92e9603a00232b189f376700
Author: David Mitchell <[email protected]>
Date:   Tue Aug 11 16:21:07 2015 +0100

    Eliminate PL_sawalias, GPf_ALIASED_SV
    
    These two commits:
    
        v5.21.3-759-gff2a62e "Skip no-common-vars optimisation for aliases"
        v5.21.4-210-gc997e36 "Make list assignment respect foreach aliasing"
    
    added a run-time mechanism to detect aliased package variables,
    by either "*pkg = ...," or "for $pkg (...)", and used that information
    to enable the OPpASSIGN_COMMON mechanism at runtime for detecting common
    elements in a list assign, e.g.
    
        for $alias ($a, ...) {
            ($a,$b) = (1,$alias);
        }
    
    The previous commit but one changed the OPpASSIGN_COMMON mechanism such
    that it no longer uses PL_sawalias. So this var and the mechanism for
    setting it can now be removed.
    
    This commit removes:
    
        * the PL_sawalias variable
        * the GPf_ALIASED_SV GP flag
        * the SAVEt_GP_ALIASED_SV and save_aliased_sv() save type.

M       dump.c
M       embed.fnc
M       embed.h
M       embedvar.h
M       ext/B/t/b.t
M       gv.h
M       intrpvar.h
M       pp_ctl.c
M       pp_hot.c
M       proto.h
M       scope.c
M       scope.h
M       sv.c

commit 90ce4d0578578878b213fa81e151eead287da29e
Author: David Mitchell <[email protected]>
Date:   Thu Aug 13 15:01:23 2015 +0100

    make my (...) = @_ non-OPpASSIGN_COMMON_RC1
    
    Technically in
    
        my ($scalar,...) = @_
    
    due to closure/goto tricks, its possible for $scalar to appear on both
    the LHS and RHS, so we currently set the OPpASSIGN_COMMON_RC1 flag.
    
    However, this imposes extra overhead; for example 5% extra instruction
    reads and 11% extra conditional branches for
    
        my ($x,$y,$z) = @_;
    
    Given what an important construct this is, disable this flag in the
    specific case of of only my's on the LHS and only @_ on the RHS.
    It's technically incorrect, but its the same behaviour we've always had
    (it was only the previous commit which made it safe but slower).
    
    We still set the OPpASSIGN_COMMON_AGG flag for
    
        my ($...,@a) = @_
    
    since in the normal case this only adds the small additional runtime
    overhead of checking that @a is already empty.

M       ext/B/t/optree_misc.t
M       op.c
M       t/op/aassign.t
M       t/perf/optree.t

commit a5f48505593c7e1ca478de383e24d5cc2541f3ca
Author: David Mitchell <[email protected]>
Date:   Thu Aug 13 10:32:42 2015 +0100

    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.

M       MANIFEST
M       embed.fnc
M       embed.h
M       ext/B/t/f_map.t
M       ext/B/t/f_sort.t
M       ext/B/t/optree_misc.t
M       ext/B/t/optree_samples.t
M       ext/B/t/optree_sort.t
M       lib/B/Op_private.pm
M       op.c
M       opcode.h
M       pp_hot.c
M       proto.h
M       regen/op_private
M       sv.h
A       t/op/aassign.t
M       t/op/array.t
M       t/op/hash.t
M       t/op/sort.t
M       t/perf/benchmarks
M       t/perf/optree.t
-----------------------------------------------------------------------

Summary of changes:
 MANIFEST                 |   1 +
 dump.c                   |   2 +-
 embed.fnc                |   4 -
 embed.h                  |   2 -
 embedvar.h               |   1 -
 ext/B/t/b.t              |   6 -
 ext/B/t/f_map.t          |  32 +--
 ext/B/t/f_sort.t         |  60 ++--
 ext/B/t/optree_misc.t    |  12 +-
 ext/B/t/optree_samples.t |   8 +-
 ext/B/t/optree_sort.t    |   8 +-
 gv.h                     |  11 -
 intrpvar.h               |   6 +-
 lib/B/Op_private.pm      |  14 +-
 op.c                     | 704 ++++++++++++++++++++++++++++++++++-------------
 opcode.h                 | 418 ++++++++++++++--------------
 pad.h                    |   5 +-
 pp_ctl.c                 |   1 -
 pp_hot.c                 | 303 ++++++++++++++++----
 proto.h                  |   4 -
 regen/op_private         |  15 +-
 scope.c                  |  28 --
 scope.h                  |   2 +-
 sv.c                     |  21 +-
 sv.h                     |   4 +-
 t/op/aassign.t           | 335 ++++++++++++++++++++++
 t/op/array.t             |   8 +-
 t/op/hash.t              |   7 +
 t/op/sort.t              |  18 +-
 t/perf/benchmarks        | 380 +++++++++++++++++++++++++
 t/perf/optree.t          |  87 +++++-
 31 files changed, 1887 insertions(+), 620 deletions(-)
 create mode 100644 t/op/aassign.t

diff --git a/MANIFEST b/MANIFEST
index c570662..097427f 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5150,6 +5150,7 @@ t/mro/vulcan_dfs.t                mro tests
 t/mro/vulcan_dfs_utf8.t                utf8 mro tests
 toke.c                         The tokener
 t/op/64bitint.t                        See if 64 bit integers work
+t/op/aassign.t                 test list assign
 t/op/alarm.t                   See if alarm works
 t/op/anonconst.t               See if :const works
 t/op/anonsub.t                 See if anonymous subroutines work
diff --git a/dump.c b/dump.c
index 7369a9a..778e345 100644
--- a/dump.c
+++ b/dump.c
@@ -2032,7 +2032,7 @@ Perl_do_sv_dump(pTHX_ I32 level, PerlIO *file, SV *sv, 
I32 nest, I32 maxnest, bo
        Perl_dump_indent(aTHX_ level, file, "    GPFLAGS = 0x%"UVxf
                                            " (%s)\n",
                               (UV)GvGPFLAGS(sv),
-                              GvALIASED_SV(sv) ? "ALIASED_SV" : "");
+                              "");
        Perl_dump_indent(aTHX_ level, file, "    LINE = %"IVdf"\n", 
(IV)GvLINE(sv));
        Perl_dump_indent(aTHX_ level, file, "    FILE = \"%s\"\n", GvFILE(sv));
        do_gv_dump (level, file, "    EGV", GvEGV(sv));
diff --git a/embed.fnc b/embed.fnc
index f596b1a..12c0551 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -962,9 +962,6 @@ ADMnoPR     |UV     |ASCII_TO_NEED  |const UV enc|const UV 
ch
 Apa    |OP*    |newANONLIST    |NULLOK OP* o
 Apa    |OP*    |newANONHASH    |NULLOK OP* o
 Ap     |OP*    |newANONSUB     |I32 floor|NULLOK OP* proto|NULLOK OP* block
-#if defined(PERL_IN_OP_C)
-i      |bool   |aassign_common_vars    |NULLOK OP* o
-#endif
 Apda   |OP*    |newASSIGNOP    |I32 flags|NULLOK OP* left|I32 optype|NULLOK 
OP* right
 Apda   |OP*    |newCONDOP      |I32 flags|NN OP* first|NULLOK OP* 
trueop|NULLOK OP* falseop
 Apd    |CV*    |newCONSTSUB    |NULLOK HV* stash|NULLOK const char* 
name|NULLOK SV* sv
@@ -1260,7 +1257,6 @@ Ap        |void   |savestack_grow_cnt     |I32 need
 Amp    |void   |save_aelem     |NN AV* av|SSize_t idx|NN SV **sptr
 Ap     |void   |save_aelem_flags|NN AV* av|SSize_t idx|NN SV **sptr \
                                 |const U32 flags
-p      |void   |save_aliased_sv|NN GV* gv
 Ap     |I32    |save_alloc     |I32 size|I32 pad
 Ap     |void   |save_aptr      |NN AV** aptr
 Ap     |AV*    |save_ary       |NN GV* gv
diff --git a/embed.h b/embed.h
index 6cebb19..0611ea9 100644
--- a/embed.h
+++ b/embed.h
@@ -1304,7 +1304,6 @@
 #define rsignal_restore(a,b)   Perl_rsignal_restore(aTHX_ a,b)
 #define rsignal_save(a,b,c)    Perl_rsignal_save(aTHX_ a,b,c)
 #define rxres_save(a,b)                Perl_rxres_save(aTHX_ a,b)
-#define save_aliased_sv(a)     Perl_save_aliased_sv(aTHX_ a)
 #define save_strlen(a)         Perl_save_strlen(aTHX_ a)
 #define sawparens(a)           Perl_sawparens(aTHX_ a)
 #define scalar(a)              Perl_scalar(aTHX_ a)
@@ -1526,7 +1525,6 @@
 #define mro_get_linear_isa_dfs(a,b)    S_mro_get_linear_isa_dfs(aTHX_ a,b)
 #  endif
 #  if defined(PERL_IN_OP_C)
-#define aassign_common_vars(a) S_aassign_common_vars(aTHX_ a)
 #define apply_attrs(a,b,c)     S_apply_attrs(aTHX_ a,b,c)
 #define apply_attrs_my(a,b,c,d)        S_apply_attrs_my(aTHX_ a,b,c,d)
 #define assignment_type(a)     S_assignment_type(aTHX_ a)
diff --git a/embedvar.h b/embedvar.h
index 9ed30e0..c6213c0 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -270,7 +270,6 @@
 #define PL_savestack           (vTHX->Isavestack)
 #define PL_savestack_ix                (vTHX->Isavestack_ix)
 #define PL_savestack_max       (vTHX->Isavestack_max)
-#define PL_sawalias            (vTHX->Isawalias)
 #ifndef PL_sawampersand
 #define PL_sawampersand                (vTHX->Isawampersand)
 #endif
diff --git a/ext/B/t/b.t b/ext/B/t/b.t
index 1420f91..4638c3e 100644
--- a/ext/B/t/b.t
+++ b/ext/B/t/b.t
@@ -209,12 +209,6 @@ is($gv_ref->SAFENAME(), "gv", "Test SAFENAME()");
 like($gv_ref->FILE(), qr/b\.t$/, "Testing FILE()");
 is($gv_ref->SvTYPE(), B::SVt_PVGV, "Test SvTYPE()");
 is($gv_ref->FLAGS() & B::SVTYPEMASK, B::SVt_PVGV, "Test SVTYPEMASK");
-is($gv_ref->GPFLAGS & B::GPf_ALIASED_SV, 0, 'GPFLAGS are unset');
-{
-    local *gv = \my $x;
-    is($gv_ref->GPFLAGS & B::GPf_ALIASED_SV, B::GPf_ALIASED_SV,
-        'GPFLAGS gets GPf_ALIASED_SV set');
-}    
 
 # The following return B::SPECIALs.
 is(ref B::sv_yes(), "B::SPECIAL", "B::sv_yes()");
diff --git a/ext/B/t/f_map.t b/ext/B/t/f_map.t
index 4f19427..a1cbc38 100644
--- a/ext/B/t/f_map.t
+++ b/ext/B/t/f_map.t
@@ -59,7 +59,7 @@ checkOptree(note   => q{},
 # a  <0> pushmark s
 # b  <#> gv[*chars] s
 # c  <1> rv2av[t2] lKRM*/1
-# d  <2> aassign[t9] KS/COMMON
+# d  <2> aassign[t9] KS/COM_AGG
 # e  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 559 (eval 15):1) v
@@ -75,7 +75,7 @@ EOT_EOT
 # a  <0> pushmark s
 # b  <$> gv(*chars) s
 # c  <1> rv2av[t1] lKRM*/1
-# d  <2> aassign[t6] KS/COMMON
+# d  <2> aassign[t6] KS/COM_AGG
 # e  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -109,7 +109,7 @@ checkOptree(note   => q{},
 # g  <0> pushmark s
 # h  <#> gv[*hash] s
 # i  <1> rv2hv lKRM*/1
-# j  <2> aassign[t10] KS/COMMON
+# j  <2> aassign[t10] KS/COM_AGG
 # k  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 560 (eval 15):1) v:{
@@ -131,7 +131,7 @@ EOT_EOT
 # g  <0> pushmark s
 # h  <$> gv(*hash) s
 # i  <1> rv2hv lKRM*/1
-# j  <2> aassign[t5] KS/COMMON
+# j  <2> aassign[t5] KS/COM_AGG
 # k  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -244,7 +244,7 @@ checkOptree(note   => q{},
 # b  <0> pushmark s
 # c  <#> gv[*hash] s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t10] KS/COMMON
+# e  <2> aassign[t10] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 560 (eval 15):1) v
@@ -261,7 +261,7 @@ EOT_EOT
 # b  <0> pushmark s
 # c  <$> gv(*hash) s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t6] KS/COMMON
+# e  <2> aassign[t6] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -290,7 +290,7 @@ checkOptree(note   => q{},
 # b  <0> pushmark s
 # c  <#> gv[*hash] s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t10] KS/COMMON
+# e  <2> aassign[t10] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 560 (eval 15):1) v
@@ -307,7 +307,7 @@ EOT_EOT
 # b  <0> pushmark s
 # c  <$> gv(*hash) s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t6] KS/COMMON
+# e  <2> aassign[t6] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -336,7 +336,7 @@ checkOptree(note   => q{},
 # b  <0> pushmark s
 # c  <#> gv[*hash] s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t9] KS/COMMON
+# e  <2> aassign[t9] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 589 (eval 26):1) v
@@ -353,7 +353,7 @@ EOT_EOT
 # b  <0> pushmark s
 # c  <$> gv(*hash) s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t5] KS/COMMON
+# e  <2> aassign[t5] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -382,7 +382,7 @@ checkOptree(note   => q{},
 # b  <0> pushmark s
 # c  <#> gv[*hash] s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t8] KS/COMMON
+# e  <2> aassign[t8] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 593 (eval 28):1) v
@@ -399,7 +399,7 @@ EOT_EOT
 # b  <0> pushmark s
 # c  <$> gv(*hash) s
 # d  <1> rv2hv lKRM*/1
-# e  <2> aassign[t5] KS/COMMON
+# e  <2> aassign[t5] KS/COM_AGG
 # f  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -427,7 +427,7 @@ checkOptree(note   => q{},
 # a  <0> pushmark s
 # b  <#> gv[*hash] s
 # c  <1> rv2hv lKRM*/1
-# d  <2> aassign[t6] KS/COMMON
+# d  <2> aassign[t6] KS/COM_AGG
 # e  <#> gv[*array] s
 # f  <1> rv2av[t8] K/1
 # g  <@> list K
@@ -446,7 +446,7 @@ EOT_EOT
 # a  <0> pushmark s
 # b  <$> gv(*hash) s
 # c  <1> rv2hv lKRM*/1
-# d  <2> aassign[t4] KS/COMMON
+# d  <2> aassign[t4] KS/COM_AGG
 # e  <$> gv(*array) s
 # f  <1> rv2av[t5] K/1
 # g  <@> list K
@@ -480,7 +480,7 @@ checkOptree(note   => q{},
 # d  <0> pushmark s
 # e  <#> gv[*hashes] s
 # f  <1> rv2av[t2] lKRM*/1
-# g  <2> aassign[t8] KS/COMMON
+# g  <2> aassign[t8] KS/COM_AGG
 # h  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 601 (eval 32):1) v
@@ -499,6 +499,6 @@ EOT_EOT
 # d  <0> pushmark s
 # e  <$> gv(*hashes) s
 # f  <1> rv2av[t1] lKRM*/1
-# g  <2> aassign[t5] KS/COMMON
+# g  <2> aassign[t5] KS/COM_AGG
 # h  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
diff --git a/ext/B/t/f_sort.t b/ext/B/t/f_sort.t
index 55811ed..eda5a21 100644
--- a/ext/B/t/f_sort.t
+++ b/ext/B/t/f_sort.t
@@ -60,7 +60,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t5] KS
+# a  <2> aassign[t5] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 545 (eval 15):1) v
@@ -72,7 +72,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t3] KS
+# a  <2> aassign[t3] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -97,7 +97,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t3] KS
+# a  <2> aassign[t3] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -109,7 +109,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t2] KS
+# a  <2> aassign[t2] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -135,7 +135,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t10] KS
+# a  <2> aassign[t10] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -148,7 +148,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t6] KS
+# a  <2> aassign[t6] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -173,7 +173,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t3] KS
+# a  <2> aassign[t3] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -185,7 +185,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t2] KS
+# a  <2> aassign[t2] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -210,7 +210,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t3] KS
+# a  <2> aassign[t3] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -222,7 +222,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t2] KS
+# a  <2> aassign[t2] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -247,7 +247,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t3] KS
+# a  <2> aassign[t3] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -259,7 +259,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t2] KS
+# a  <2> aassign[t2] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -288,7 +288,7 @@ checkOptree(note   => q{},
 # 8  <0> pushmark s
 # 9  <#> gv[*eldest] s
 # a  <1> rv2av[t2] lKRM*/1
-# b  <2> aassign[t11] KS/COMMON
+# b  <2> aassign[t11] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -303,7 +303,7 @@ EOT_EOT
 # 8  <0> pushmark s
 # 9  <$> gv(*eldest) s
 # a  <1> rv2av[t1] lKRM*/1
-# b  <2> aassign[t5] KS/COMMON
+# b  <2> aassign[t5] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -333,7 +333,7 @@ checkOptree(note   => q{},
 # 8  <0> pushmark s
 # 9  <#> gv[*sortedclass] s
 # a  <1> rv2av[t2] lKRM*/1
-# b  <2> aassign[t5] KS
+# b  <2> aassign[t5] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -347,7 +347,7 @@ EOT_EOT
 # 8  <0> pushmark s
 # 9  <$> gv(*sortedclass) s
 # a  <1> rv2av[t1] lKRM*/1
-# b  <2> aassign[t3] KS
+# b  <2> aassign[t3] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -530,7 +530,7 @@ checkOptree(name   => q{Compound sort/map Expression },
 # n  <0> pushmark s
 # o  <#> gv[*new] s
 # p  <1> rv2av[t2] lKRM*/1
-# q  <2> aassign[t22] KS/COMMON
+# q  <2> aassign[t22] KS/COM_AGG
 # r  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 609 (eval 34):3) v:{
@@ -560,7 +560,7 @@ EOT_EOT
 # n  <0> pushmark s
 # o  <$> gv(*new) s
 # p  <1> rv2av[t1] lKRM*/1
-# q  <2> aassign[t13] KS/COMMON
+# q  <2> aassign[t13] KS/COM_AGG
 # r  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -592,7 +592,7 @@ checkOptree(name   => q{sort other::sub LIST },
 # 8  <0> pushmark s
 # 9  <#> gv[*new] s
 # a  <1> rv2av[t2] lKRM*/1
-# b  <2> aassign[t5] KS
+# b  <2> aassign[t5] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 614 (eval 36):2) v:{
@@ -606,7 +606,7 @@ EOT_EOT
 # 8  <0> pushmark s
 # 9  <$> gv(*new) s
 # a  <1> rv2av[t1] lKRM*/1
-# b  <2> aassign[t3] KS
+# b  <2> aassign[t3] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -634,7 +634,7 @@ checkOptree(note   => q{},
 # 8  <0> pushmark s
 # 9  <#> gv[*new] s
 # a  <1> rv2av[t2] lKRM*/1
-# b  <2> aassign[t5] KS
+# b  <2> aassign[t5] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -648,7 +648,7 @@ EOT_EOT
 # 8  <0> pushmark s
 # 9  <$> gv(*new) s
 # a  <1> rv2av[t1] lKRM*/1
-# b  <2> aassign[t3] KS
+# b  <2> aassign[t3] KS/COM_AGG
 # c  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -672,7 +672,7 @@ my ($expect, $expect_nt) = (<<'EOT_EOT', <<'EONT_EONT');
 # 7  <0> pushmark s
 # 8  <#> gv[*new] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t14] KS
+# 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:%,{
@@ -685,7 +685,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*new) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t6] KS
+# a  <2> aassign[t6] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -717,7 +717,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*new] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t14] KS
+# 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:%,{
@@ -730,7 +730,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*new) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t6] KS
+# a  <2> aassign[t6] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -756,7 +756,7 @@ checkOptree(note   => q{},
 # 7  <0> pushmark s
 # 8  <#> gv[*articles] s
 # 9  <1> rv2av[t2] lKRM*/1
-# a  <2> aassign[t8] KS
+# a  <2> aassign[t8] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 546 (eval 15):1) v
@@ -769,7 +769,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*articles) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t4] KS
+# a  <2> aassign[t4] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
@@ -803,7 +803,7 @@ checkOptree(note   => q{},
 # d  <0> pushmark s
 # e  <#> gv[*result] s
 # f  <1> rv2av[t2] lKRM*/1
-# g  <2> aassign[t3] KS/COMMON
+# g  <2> aassign[t3] KS/COM_AGG
 # h  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 547 (eval 15):1) v
@@ -824,7 +824,7 @@ EOT_EOT
 # d  <0> pushmark s
 # e  <$> gv(*result) s
 # f  <1> rv2av[t1] lKRM*/1
-# g  <2> aassign[t2] KS/COMMON
+# g  <2> aassign[t2] KS/COM_AGG
 # h  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
     
diff --git a/ext/B/t/optree_misc.t b/ext/B/t/optree_misc.t
index 9bfcc49..2d6b80f 100644
--- a/ext/B/t/optree_misc.t
+++ b/ext/B/t/optree_misc.t
@@ -205,7 +205,7 @@ checkOptree ( name      => 'padrange',
 # -           <0> padsv[$x:1,2] vM/LVINTRO ->-
 # -           <0> padsv[$y:1,2] vM/LVINTRO ->-
 # 3        <;> nextstate(main 2 -e:1) v:>,<,% ->4
-# 8        <2> aassign[t4] vKS ->9
+# 8        <2> aassign[t4] vKS/COM_AGG ->9
 # -           <1> ex-list lKP ->5
 # 4              <0> padrange[$x:1,2; $y:1,2] /2 ->5
 # -              <0> padsv[$x:1,2] s ->-
@@ -215,7 +215,7 @@ checkOptree ( name      => 'padrange',
 # 7              <1> rv2av[t3] lKRM*/1 ->8
 # 6                 <#> gv[*a] s ->7
 # 9        <;> nextstate(main 2 -e:1) v:>,<,%,{ ->a
-# e        <2> aassign[t6] KS ->f
+# e        <2> aassign[t6] KS/COM_RC1 ->f
 # -           <1> ex-list lK ->d
 # a              <0> pushmark s ->b
 # c              <1> rv2av[t5] lK/1 ->d
@@ -233,7 +233,7 @@ EOT_EOT
 # -           <0> padsv[$x:1,2] vM/LVINTRO ->-
 # -           <0> padsv[$y:1,2] vM/LVINTRO ->-
 # 3        <;> nextstate(main 2 -e:1) v:>,<,% ->4
-# 8        <2> aassign[t4] vKS ->9
+# 8        <2> aassign[t4] vKS/COM_AGG ->9
 # -           <1> ex-list lKP ->5
 # 4              <0> padrange[$x:1,2; $y:1,2] /2 ->5
 # -              <0> padsv[$x:1,2] s ->-
@@ -243,7 +243,7 @@ EOT_EOT
 # 7              <1> rv2av[t3] lKRM*/1 ->8
 # 6                 <$> gv(*a) s ->7
 # 9        <;> nextstate(main 2 -e:1) v:>,<,%,{ ->a
-# e        <2> aassign[t6] KS ->f
+# e        <2> aassign[t6] KS/COM_RC1 ->f
 # -           <1> ex-list lK ->d
 # a              <0> pushmark s ->b
 # c              <1> rv2av[t5] lK/1 ->d
@@ -276,7 +276,7 @@ checkOptree ( name      => 'padrange and @_',
 # -              <0> padsv[$a:1,4] sRM*/LVINTRO ->-
 # -              <0> padsv[$b:1,4] sRM*/LVINTRO ->-
 # 4        <;> nextstate(main 2 p3:2) v:>,<,% ->5
-# 9        <2> aassign[t10] vKS ->a
+# 9        <2> aassign[t10] vKS/COM_RC1 ->a
 # -           <1> ex-list lK ->8
 # 5              <0> pushmark s ->6
 # 7              <1> rv2av[t9] lK/1 ->8
@@ -309,7 +309,7 @@ EOT_EOT
 # -              <0> padsv[$a:1,4] sRM*/LVINTRO ->-
 # -              <0> padsv[$b:1,4] sRM*/LVINTRO ->-
 # 4        <;> nextstate(main 2 p3:2) v:>,<,% ->5
-# 9        <2> aassign[t10] vKS ->a
+# 9        <2> aassign[t10] vKS/COM_RC1 ->a
 # -           <1> ex-list lK ->8
 # 5              <0> pushmark s ->6
 # 7              <1> rv2av[t9] lK/1 ->8
diff --git a/ext/B/t/optree_samples.t b/ext/B/t/optree_samples.t
index d259bf9..c6288d9 100644
--- a/ext/B/t/optree_samples.t
+++ b/ext/B/t/optree_samples.t
@@ -437,7 +437,7 @@ checkOptree ( name  => '@foo = grep(!/^\#/, @bar)',
 # a  <0> pushmark s
 # b  <#> gv[*foo] s
 # c  <1> rv2av[t2] lKRM*/1
-# d  <2> aassign[t6] KS
+# d  <2> aassign[t6] KS/COM_AGG
 # e  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 496 (eval 20):1) v:{
@@ -453,7 +453,7 @@ EOT_EOT
 # a  <0> pushmark s
 # b  <$> gv(*foo) s
 # c  <1> rv2av[t1] lKRM*/1
-# d  <2> aassign[t4] KS
+# d  <2> aassign[t4] KS/COM_AGG
 # e  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -485,7 +485,7 @@ checkOptree ( name  => '%h = map { getkey($_) => $_ } @a',
 # h  <#> gv[*h] s
 # i  <1> rv2hv[t2] lKRM*/1         < 5.019006
 # i  <1> rv2hv lKRM*/1             >=5.019006
-# j  <2> aassign[t10] KS/COMMON
+# j  <2> aassign[t10] KS/COM_AGG
 # k  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 501 (eval 22):1) v:{
@@ -509,7 +509,7 @@ EOT_EOT
 # h  <$> gv(*h) s
 # i  <1> rv2hv[t1] lKRM*/1         < 5.019006
 # i  <1> rv2hv lKRM*/1             >=5.019006
-# j  <2> aassign[t5] KS/COMMON
+# j  <2> aassign[t5] KS/COM_AGG
 # k  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
diff --git a/ext/B/t/optree_sort.t b/ext/B/t/optree_sort.t
index 660d9b2..0b5897d 100644
--- a/ext/B/t/optree_sort.t
+++ b/ext/B/t/optree_sort.t
@@ -77,7 +77,7 @@ checkOptree ( name    => 'sub {@a = sort @a}',
 7  <0> pushmark s
 8  <#> gv[*a] s
 9  <1> rv2av[t2] lKRM*/1
-a  <2> aassign[t5] KS/COMMON
+a  <2> aassign[t5] KS/COM_AGG
 b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 65 optree.t:311) v:>,<,%
@@ -89,7 +89,7 @@ EOT_EOT
 # 7  <0> pushmark s
 # 8  <$> gv(*a) s
 # 9  <1> rv2av[t1] lKRM*/1
-# a  <2> aassign[t3] KS/COMMON
+# a  <2> aassign[t3] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
@@ -198,7 +198,7 @@ checkOptree ( name  => 'sub {my @a; @a = sort @a}',
 7  <@> sort lK
 8  <0> pushmark s
 9  <0> padav[@a:-437,-436] lRM*
-a  <2> aassign[t2] KS/COMMON
+a  <2> aassign[t2] KS/COM_AGG
 b  <1> leavesub[1 ref] K/REFC,1
 EOT_EOT
 # 1  <;> nextstate(main 427 optree_sort.t:172) v:>,<,%
@@ -210,7 +210,7 @@ EOT_EOT
 # 7  <@> sort lK
 # 8  <0> pushmark s
 # 9  <0> padav[@a:-437,-436] lRM*
-# a  <2> aassign[t2] KS/COMMON
+# a  <2> aassign[t2] KS/COM_AGG
 # b  <1> leavesub[1 ref] K/REFC,1
 EONT_EONT
 
diff --git a/gv.h b/gv.h
index a6bb749..a6b695e 100644
--- a/gv.h
+++ b/gv.h
@@ -72,11 +72,6 @@ struct gp {
 #define GvNAME(gv)     GvNAME_get(gv)
 #define GvNAMELEN(gv)  GvNAMELEN_get(gv)
 
-#define        GvASSIGN_GENERATION(gv)         (0 + ((XPV*) 
SvANY(gv))->xpv_len)
-#define        GvASSIGN_GENERATION_set(gv,val)                 \
-       STMT_START { assert(SvTYPE(gv) == SVt_PVGV);    \
-               (((XPV*) SvANY(gv))->xpv_len = (val)); } STMT_END
-
 /*
 =head1 GV Functions
 
@@ -198,12 +193,6 @@ Return the CV from the GV.
 #define GvIMPORTED_CV_on(gv)   (GvFLAGS(gv) |= GVf_IMPORTED_CV)
 #define GvIMPORTED_CV_off(gv)  (GvFLAGS(gv) &= ~GVf_IMPORTED_CV)
 
-#define GPf_ALIASED_SV 1
-
-#define GvALIASED_SV(gv)       (GvGPFLAGS(gv) & GPf_ALIASED_SV)
-#define GvALIASED_SV_on(gv)    (GvGPFLAGS(gv) |= GPf_ALIASED_SV)
-#define GvALIASED_SV_off(gv)   (GvGPFLAGS(gv) &= ~GPf_ALIASED_SV)
-
 #ifndef PERL_CORE
 #  define GvIN_PAD(gv)         0
 #  define GvIN_PAD_on(gv)      NOOP
diff --git a/intrpvar.h b/intrpvar.h
index 6ee88b3..20fd4df 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -60,9 +60,6 @@ PERLVAR(I, markstack, I32 *)          /* stack_sp locations 
we're
 PERLVAR(I, markstack_ptr, I32 *)
 PERLVAR(I, markstack_max, I32 *)
 
-PERLVARI(I, sawalias,  bool,   FALSE)  /* must enable common-vars
-                                          pessimisation */
-
 #ifdef PERL_HASH_RANDOMIZE_KEYS
 #ifdef USE_PERL_PERTURB_KEYS
 PERLVARI(I, hash_rand_bits_enabled, U8, 1) /* used to randomize hash stuff 0 
== no-random, 1 == random, 2 == determinsitic */
@@ -492,7 +489,8 @@ PERLVAR(I, sys_intern,      struct interp_intern)
 
 /* more statics moved here */
 PERLVAR(I, DBcv,       CV *)           /* from perl.c */
-PERLVARI(I, generation,        int,    100)    /* from op.c */
+PERLVARI(I, generation,        int,    100)    /* scan sequence# for OP_AASSIGN
+                                           compile-time common elem detection 
*/
 
 PERLVAR(I, unicode, U32)       /* Unicode features: $ENV{PERL_UNICODE} or -C */
 
diff --git a/lib/B/Op_private.pm b/lib/B/Op_private.pm
index c300a9d..f889efc 100644
--- a/lib/B/Op_private.pm
+++ b/lib/B/Op_private.pm
@@ -228,7 +228,7 @@ my @bf = (
     },
 );
 
-@{$bits{aassign}}{6,1,0} = ('OPpASSIGN_COMMON', $bf[1], $bf[1]);
+@{$bits{aassign}}{6,5,4,1,0} = ('OPpASSIGN_COMMON_SCALAR', 
'OPpASSIGN_COMMON_RC1', 'OPpASSIGN_COMMON_AGG', $bf[1], $bf[1]);
 $bits{abs}{0} = $bf[0];
 @{$bits{accept}}{3,2,1,0} = ($bf[3], $bf[3], $bf[3], $bf[3]);
 @{$bits{add}}{1,0} = ($bf[1], $bf[1]);
@@ -567,7 +567,9 @@ our %defines = (
     OPpARG3_MASK             =>   7,
     OPpARG4_MASK             =>  15,
     OPpASSIGN_BACKWARDS      =>  64,
-    OPpASSIGN_COMMON         =>  64,
+    OPpASSIGN_COMMON_AGG     =>  16,
+    OPpASSIGN_COMMON_RC1     =>  32,
+    OPpASSIGN_COMMON_SCALAR  =>  64,
     OPpASSIGN_CV_TO_GV       => 128,
     OPpCONST_BARE            =>  64,
     OPpCONST_ENTERED         =>  16,
@@ -660,7 +662,9 @@ our %defines = (
 our %labels = (
     OPpALLOW_FAKE            => 'FAKE',
     OPpASSIGN_BACKWARDS      => 'BKWARD',
-    OPpASSIGN_COMMON         => 'COMMON',
+    OPpASSIGN_COMMON_AGG     => 'COM_AGG',
+    OPpASSIGN_COMMON_RC1     => 'COM_RC1',
+    OPpASSIGN_COMMON_SCALAR  => 'COM_SCALAR',
     OPpASSIGN_CV_TO_GV       => 'CV2GV',
     OPpCONST_BARE            => 'BARE',
     OPpCONST_ENTERED         => 'ENTERED',
@@ -750,7 +754,7 @@ our %labels = (
 our %ops_using = (
     OPpALLOW_FAKE            => [qw(rv2gv)],
     OPpASSIGN_BACKWARDS      => [qw(sassign)],
-    OPpASSIGN_COMMON         => [qw(aassign)],
+    OPpASSIGN_COMMON_AGG     => [qw(aassign)],
     OPpCONST_BARE            => [qw(const)],
     OPpCOREARGS_DEREF1       => [qw(coreargs)],
     OPpEARLY_CV              => [qw(gv)],
@@ -793,6 +797,8 @@ our %ops_using = (
     OPpTRANS_COMPLEMENT      => [qw(trans transr)],
 );
 
+$ops_using{OPpASSIGN_COMMON_RC1} = $ops_using{OPpASSIGN_COMMON_AGG};
+$ops_using{OPpASSIGN_COMMON_SCALAR} = $ops_using{OPpASSIGN_COMMON_AGG};
 $ops_using{OPpASSIGN_CV_TO_GV} = $ops_using{OPpASSIGN_BACKWARDS};
 $ops_using{OPpCONST_ENTERED} = $ops_using{OPpCONST_BARE};
 $ops_using{OPpCONST_NOVER} = $ops_using{OPpCONST_BARE};
diff --git a/op.c b/op.c
index ae1eb30..2d51b6d 100644
--- a/op.c
+++ b/op.c
@@ -6303,132 +6303,6 @@ S_assignment_type(pTHX_ const OP *o)
     return ret;
 }
 
-/*
-  Helper function for newASSIGNOP to detect commonality between the
-  lhs and the rhs.  (It is actually called very indirectly.  newASSIGNOP
-  flags the op and the peephole optimizer calls this helper function
-  if the flag is set.)  Marks all variables with PL_generation.  If it
-  returns TRUE the assignment must be able to handle common variables.
-
-  PL_generation sorcery:
-  An assignment like ($a,$b) = ($c,$d) is easier than
-  ($a,$b) = ($c,$a), since there is no need for temporary vars.
-  To detect whether there are common vars, the global var
-  PL_generation is incremented for each assign op we compile.
-  Then, while compiling the assign op, we run through all the
-  variables on both sides of the assignment, setting a spare slot
-  in each of them to PL_generation.  If any of them already have
-  that value, we know we've got commonality.  Also, if the
-  generation number is already set to PERL_INT_MAX, then
-  the variable is involved in aliasing, so we also have
-  potential commonality in that case.  We could use a
-  single bit marker, but then we'd have to make 2 passes, first
-  to clear the flag, then to test and set it.  And that
-  wouldn't help with aliasing, either.  To find somewhere
-  to store these values, evil chicanery is done with SvUVX().
-*/
-PERL_STATIC_INLINE bool
-S_aassign_common_vars(pTHX_ OP* o)
-{
-    OP *curop;
-    for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) {
-       if (PL_opargs[curop->op_type] & OA_DANGEROUS) {
-           if (curop->op_type == OP_GV || curop->op_type == OP_GVSV
-            || curop->op_type == OP_AELEMFAST) {
-               GV *gv = cGVOPx_gv(curop);
-               if (gv == PL_defgv
-                   || (int)GvASSIGN_GENERATION(gv) == PL_generation)
-                   return TRUE;
-               GvASSIGN_GENERATION_set(gv, PL_generation);
-           }
-           else if (curop->op_type == OP_PADSV ||
-               curop->op_type == OP_PADAV ||
-               curop->op_type == OP_PADHV ||
-               curop->op_type == OP_AELEMFAST_LEX ||
-               curop->op_type == OP_PADANY)
-               {
-                 padcheck:
-                   if (PAD_COMPNAME_GEN(curop->op_targ)
-                       == (STRLEN)PL_generation
-                    || PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
-                       return TRUE;
-                   PAD_COMPNAME_GEN_set(curop->op_targ, PL_generation);
-
-               }
-           else if (curop->op_type == OP_RV2CV)
-               return TRUE;
-           else if (curop->op_type == OP_RV2SV ||
-               curop->op_type == OP_RV2AV ||
-               curop->op_type == OP_RV2HV ||
-               curop->op_type == OP_RV2GV) {
-               if (cUNOPx(curop)->op_first->op_type != OP_GV)  /* funny deref? 
*/
-                   return TRUE;
-           }
-           else if (curop->op_type == OP_PUSHRE) {
-               GV *const gv =
-#ifdef USE_ITHREADS
-                   ((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff
-                       ? 
MUTABLE_GV(PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff))
-                       : NULL;
-#else
-                   ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
-#endif
-               if (gv) {
-                   if (gv == PL_defgv
-                       || (int)GvASSIGN_GENERATION(gv) == PL_generation)
-                       return TRUE;
-                   GvASSIGN_GENERATION_set(gv, PL_generation);
-               }
-               else if (curop->op_targ)
-                   goto padcheck;
-           }
-           else if (curop->op_type == OP_PADRANGE)
-               /* Ignore padrange; checking its siblings is sufficient. */
-               continue;
-           else
-               return TRUE;
-       }
-       else if (PL_opargs[curop->op_type] & OA_TARGLEX
-             && curop->op_private & OPpTARGET_MY)
-           goto padcheck;
-
-       if (curop->op_flags & OPf_KIDS) {
-           if (aassign_common_vars(curop))
-               return TRUE;
-       }
-    }
-    return FALSE;
-}
-
-/* This variant only handles lexical aliases.  It is called when
-   newASSIGNOP decides that we don’t have any common vars, as lexical ali-
-   ases trump that decision.  */
-PERL_STATIC_INLINE bool
-S_aassign_common_vars_aliases_only(pTHX_ OP *o)
-{
-    OP *curop;
-    for (curop = cUNOPo->op_first; curop; curop = OpSIBLING(curop)) {
-       if ((curop->op_type == OP_PADSV ||
-            curop->op_type == OP_PADAV ||
-            curop->op_type == OP_PADHV ||
-            curop->op_type == OP_AELEMFAST_LEX ||
-            curop->op_type == OP_PADANY ||
-            (  PL_opargs[curop->op_type] & OA_TARGLEX
-            && curop->op_private & OPpTARGET_MY  ))
-          && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
-           return TRUE;
-
-       if (curop->op_type == OP_PUSHRE && curop->op_targ
-        && PAD_COMPNAME_GEN(curop->op_targ) == PERL_INT_MAX)
-           return TRUE;
-
-       if (curop->op_flags & OPf_KIDS) {
-           if (S_aassign_common_vars_aliases_only(aTHX_ curop))
-               return TRUE;
-       }
-    }
-    return FALSE;
-}
 
 /*
 =for apidoc Am|OP *|newASSIGNOP|I32 flags|OP *left|I32 optype|OP *right
@@ -6475,7 +6349,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, 
OP *right)
        static const char no_list_state[] = "Initialization of state variables"
            " in list context currently forbidden";
        OP *curop;
-       bool maybe_common_vars = TRUE;
 
        if (left->op_type == OP_ASLICE || left->op_type == OP_HSLICE)
            left->op_private &= ~ OPpSLICEWARNING;
@@ -6489,47 +6362,24 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, 
OP *right)
        if (OP_TYPE_IS_OR_WAS(left, OP_LIST))
        {
            OP* lop = ((LISTOP*)left)->op_first;
-           maybe_common_vars = FALSE;
            while (lop) {
-               if (lop->op_type == OP_PADSV ||
-                   lop->op_type == OP_PADAV ||
-                   lop->op_type == OP_PADHV ||
-                   lop->op_type == OP_PADANY) {
-                   if (!(lop->op_private & OPpLVAL_INTRO))
-                       maybe_common_vars = TRUE;
-
-                   if (lop->op_private & OPpPAD_STATE) {
-                       if (left->op_private & OPpLVAL_INTRO) {
-                           /* Each variable in state($a, $b, $c) = ... */
-                       }
-                       else {
-                           /* Each state variable in
-                              (state $a, my $b, our $c, $d, undef) = ... */
-                       }
-                       yyerror(no_list_state);
-                   } else {
-                       /* Each my variable in
-                          (state $a, my $b, our $c, $d, undef) = ... */
-                   }
-               } else if (lop->op_type == OP_UNDEF ||
-                           OP_TYPE_IS_OR_WAS(lop, OP_PUSHMARK)) {
-                   /* undef may be interesting in
-                      (state $a, undef, state $c) */
-               } else {
-                   /* Other ops in the list. */
-                   maybe_common_vars = TRUE;
-               }
+               if ((lop->op_type == OP_PADSV ||
+                    lop->op_type == OP_PADAV ||
+                    lop->op_type == OP_PADHV ||
+                    lop->op_type == OP_PADANY)
+                 && (lop->op_private & OPpPAD_STATE)
+                )
+                    yyerror(no_list_state);
                lop = OpSIBLING(lop);
            }
        }
-       else if ((left->op_private & OPpLVAL_INTRO)
+       else if (  (left->op_private & OPpLVAL_INTRO)
+                && (left->op_private & OPpPAD_STATE)
                && (   left->op_type == OP_PADSV
                    || left->op_type == OP_PADAV
                    || left->op_type == OP_PADHV
-                   || left->op_type == OP_PADANY))
-       {
-           if (left->op_type == OP_PADSV) maybe_common_vars = FALSE;
-           if (left->op_private & OPpPAD_STATE) {
+                   || left->op_type == OP_PADANY)
+        ) {
                /* All single variable list context state assignments, hence
                   state ($a) = ...
                   (state $a) = ...
@@ -6541,13 +6391,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, 
OP *right)
                   (state %a) = ...
                */
                yyerror(no_list_state);
-           }
-       }
-
-       if (maybe_common_vars) {
-               /* The peephole optimizer will do the full check and pos-
-                  sibly turn this off.  */
-               o->op_private |= OPpASSIGN_COMMON;
        }
 
        if (right && right->op_type == OP_SPLIT
@@ -12097,6 +11940,418 @@ Perl_ck_length(pTHX_ OP *o)
     return o;
 }
 
+
+
+/* 
+   ---------------------------------------------------------
+ 
+   Common vars in list assignment
+
+   There now follows some enums and static functions for detecting
+   common variables in list assignments. Here is a little essay I wrote
+   for myself when trying to get my head around this. DAPM.
+
+   ----
+
+   First some random observations:
+   
+   * If a lexical var is an alias of something else, e.g.
+       for my $x ($lex, $pkg, $a[0]) {...}
+     then the act of aliasing will increase the reference count of the SV
+   
+   * If a package var is an alias of something else, it may still have a
+     reference count of 1, depending on how the alias was created, e.g.
+     in *a = *b, $a may have a refcount of 1 since the GP is shared
+     with a single GvSV pointer to the SV. So If it's an alias of another
+     package var, then RC may be 1; if it's an alias of another scalar, e.g.
+     a lexical var or an array element, then it will have RC > 1.
+   
+   * There are many ways to create a package alias; ultimately, XS code
+     may quite legally do GvSV(gv) = SvREFCNT_inc(sv) for example, so
+     run-time tracing mechanisms are unlikely to be able to catch all cases.
+   
+   * When the LHS is all my declarations, the same vars can't appear directly
+     on the RHS, but they can indirectly via closures, aliasing and lvalue
+     subs. But those techniques all involve an increase in the lexical
+     scalar's ref count.
+   
+   * When the LHS is all lexical vars (but not necessarily my declarations),
+     it is possible for the same lexicals to appear directly on the RHS, and
+     without an increased ref count, since the stack isn't refcounted.
+     This case can be detected at compile time by scanning for common lex
+     vars with PL_generation.
+   
+   * lvalue subs defeat common var detection, but they do at least
+     return vars with a temporary ref count increment. Also, you can't
+     tell at compile time whether a sub call is lvalue.
+   
+    
+   So...
+         
+   A: There are a few circumstances where there definitely can't be any
+     commonality:
+   
+       LHS empty:  () = (...);
+       RHS empty:  (....) = ();
+       RHS contains only constants or other 'can't possibly be shared'
+           elements (e.g. ops that return PADTMPs):  (...) = (1,2, length)
+           i.e. they only contain ops not marked as dangerous, whose children
+           are also not dangerous;
+       LHS ditto;
+       LHS contains a single scalar element: e.g. ($x) = (....); because
+           after $x has been modified, it won't be used again on the RHS;
+       RHS contains a single element with no aggregate on LHS: e.g.
+           ($a,$b,$c)  = ($x); again, once $a has been modified, its value
+           won't be used again.
+   
+   B: If LHS are all 'my' lexical var declarations (or safe ops, which
+     we can ignore):
+   
+       my ($a, $b, @c) = ...;
+   
+       Due to closure and goto tricks, these vars may already have content.
+       For the same reason, an element on the RHS may be a lexical or package
+       alias of one of the vars on the left, or share common elements, for
+       example:
+   
+           my ($x,$y) = f(); # $x and $y on both sides
+           sub f : lvalue { ($x,$y) = (1,2); $y, $x }
+   
+       and
+   
+           my $ra = f();
+           my @a = @$ra;  # elements of @a on both sides
+           sub f { @a = 1..4; \@a }
+   
+   
+       First, just consider scalar vars on LHS:
+   
+           RHS is safe only if (A), or in addition,
+               * contains only lexical *scalar* vars, where neither side's
+                 lexicals have been flagged as aliases 
+   
+           If RHS is not safe, then it's always legal to check LHS vars for
+           RC==1, since the only RHS aliases will always be associated
+           with an RC bump.
+   
+           Note that in particular, RHS is not safe if:
+   
+               * it contains package scalar vars; e.g.:
+   
+                   f();
+                   my ($x, $y) = (2, $x_alias);
+                   sub f { $x = 1; *x_alias = \$x; }
+   
+               * It contains other general elements, such as flattened or
+               * spliced or single array or hash elements, e.g.
+   
+                   f();
+                   my ($x,$y) = @a; # or $a[0] or @a{@b} etc 
+   
+                   sub f {
+                       ($x, $y) = (1,2);
+                       use feature 'refaliasing';
+                       \($a[0], $a[1]) = \($y,$x);
+                   }
+   
+                 It doesn't matter if the array/hash is lexical or package.
+   
+               * it contains a function call that happens to be an lvalue
+                 sub which returns one or more of the above, e.g.
+   
+                   f();
+                   my ($x,$y) = f();
+   
+                   sub f : lvalue {
+                       ($x, $y) = (1,2);
+                       *x1 = \$x;
+                       $y, $x1;
+                   }
+   
+                   (so a sub call on the RHS should be treated the same
+                   as having a package var on the RHS).
+   
+               * any other "dangerous" thing, such an op or built-in that
+                 returns one of the above, e.g. pp_preinc
+   
+   
+           If RHS is not safe, what we can do however is at compile time flag
+           that the LHS are all my declarations, and at run time check whether
+           all the LHS have RC == 1, and if so skip the full scan.
+   
+       Now consider array and hash vars on LHS: e.g. my (...,@a) = ...;
+   
+           Here the issue is whether there can be elements of @a on the RHS
+           which will get prematurely freed when @a is cleared prior to
+           assignment. This is only a problem if the aliasing mechanism
+           is one which doesn't increase the refcount - only if RC == 1
+           will the RHS element be prematurely freed.
+   
+           Because the array/hash is being INTROed, it or its elements
+           can't directly appear on the RHS:
+   
+               my (@a) = ($a[0], @a, etc) # NOT POSSIBLE
+   
+           but can indirectly, e.g.:
+   
+               my $r = f();
+               my (@a) = @$r;
+               sub f { @a = 1..3; \@a }
+   
+           So if the RHS isn't safe as defined by (A), we must always
+           mortalise and bump the ref count of any remaining RHS elements
+           when assigning to a non-empty LHS aggregate.
+   
+           Lexical scalars on the RHS aren't safe if they've been involved in
+           aliasing, e.g.
+   
+               use feature 'refaliasing';
+   
+               f();
+               \(my $lex) = \$pkg;
+               my @a = ($lex,3); # equivalent to ($a[0],3)
+   
+               sub f {
+                   @a = (1,2);
+                   \$pkg = \$a[0];
+               }
+   
+           Similarly with lexical arrays and hashes on the RHS:
+   
+               f();
+               my @b;
+               my @a = (@b);
+   
+               sub f {
+                   @a = (1,2);
+                   \$b[0] = \$a[1];
+                   \$b[1] = \$a[0];
+               }
+   
+   
+   
+   C: As (B), but in addition the LHS may contain non-intro lexicals, e.g.
+       my $a; ($a, my $b) = (....);
+   
+       The difference between (B) and (C) is that it is now physically
+       possible for the LHS vars to appear on the RHS too, where they
+       are not reference counted; but in this case, the compile-time
+       PL_generation sweep will detect such common vars.
+   
+       So the rules for (C) differ from (B) in that if common vars are
+       detected, the runtime "test RC==1" optimisation can no longer be used,
+       and a full mark and sweep is required
+   
+   D: As (C), but in addition the LHS may contain package vars.
+   
+       Since package vars can be aliased without a corresponding refcount
+       increase, all bets are off. It's only safe if (A). E.g.
+   
+           my ($x, $y) = (1,2);
+   
+           for $x_alias ($x) {
+               ($x_alias, $y) = (3, $x); # whoops
+           }
+   
+       Ditto for LHS aggregate package vars.
+   
+   E: Any other dangerous ops on LHS, e.g.
+           (f(), $a[0], @$r) = (...);
+   
+       this is similar to (E) in that all bets are off. In addition, it's
+       impossible to determine at compile time whether the LHS
+       contains a scalar or an aggregate, e.g.
+   
+           sub f : lvalue { @a }
+           (f()) = 1..3;
+
+* ---------------------------------------------------------
+*/
+
+
+/* A set of bit flags returned by S_aassign_scan(). Each flag indicates
+ * that at least one of the things flagged was seen.
+ */
+
+enum {
+    AAS_MY_SCALAR       = 0x001, /* my $scalar */
+    AAS_MY_AGG          = 0x002, /* aggregate: my @array or my %hash */
+    AAS_LEX_SCALAR      = 0x004, /* $lexical */
+    AAS_LEX_AGG         = 0x008, /* @lexical or %lexical aggregate */
+    AAS_LEX_SCALAR_COMM = 0x010, /* $lexical seen on both sides */
+    AAS_PKG_SCALAR      = 0x020, /* $scalar (where $scalar is pkg var) */
+    AAS_PKG_AGG         = 0x040, /* package @array or %hash aggregate */
+    AAS_DANGEROUS       = 0x080, /* an op (other than the above)
+                                         that's flagged OA_DANGEROUS */
+    AAS_SAFE_SCALAR     = 0x100, /* produces at least one scalar SV that's
+                                        not in any of the categories above */
+    AAS_DEFAV           = 0x200, /* contains just a single '@_' on RHS */
+};
+
+
+
+/* helper function for S_aassign_scan().
+ * check a PAD-related op for commonality and/or set its generation number.
+ * Returns a boolean indicating whether its shared */
+
+static bool
+S_aassign_padcheck(pTHX_ OP* o, bool rhs)
+{
+    if (PAD_COMPNAME_GEN(o->op_targ) == PERL_INT_MAX)
+        /* lexical used in aliasing */
+        return TRUE;
+
+    if (rhs)
+        return cBOOL(PAD_COMPNAME_GEN(o->op_targ) == (STRLEN)PL_generation);
+    else
+        PAD_COMPNAME_GEN_set(o->op_targ, PL_generation);
+
+    return FALSE;
+}
+
+
+/*
+  Helper function for OPpASSIGN_COMMON* detection in rpeep().
+  It scans the left or right hand subtree of the aassign op, and returns a
+  set of flags indicating what sorts of things it found there.
+  'rhs' indicates whether we're scanning the LHS or RHS. If the former, we
+  set PL_generation on lexical vars; if the latter, we see if
+  PL_generation matches.
+  'top' indicates whether we're recursing or at the top level.
+  'scalars_p' is a pointer to a counter of the number of scalar SVs seen.
+  This fn will increment it by the number seen. It's not intended to
+  be an accurate count (especially as many ops can push a variable
+  number of SVs onto the stack); rather it's used as to test whether there
+  can be at most 1 SV pushed; so it's only meanings are "0, 1, many".
+*/
+
+static int
+S_aassign_scan(pTHX_ OP* o, bool rhs, bool top, int *scalars_p)
+{
+    int flags = 0;
+    bool kid_top = FALSE;
+
+    /* first, look for a solitary @_ on the RHS */
+    if (   rhs
+        && top
+        && (o->op_flags & OPf_KIDS)
+        && OP_TYPE_IS_OR_WAS(o, OP_LIST)
+    ) {
+        OP *kid = cUNOPo->op_first;
+        if (   (   kid->op_type == OP_PUSHMARK
+                || kid->op_type == OP_PADRANGE) /* ex-pushmark */
+            && ((kid = OpSIBLING(kid)))
+            && !OpHAS_SIBLING(kid)
+            && kid->op_type == OP_RV2AV
+            && !(kid->op_flags & OPf_REF)
+            && !(kid->op_private & (OPpLVAL_INTRO|OPpMAYBE_LVSUB))
+            && ((kid->op_flags & OPf_WANT) == OPf_WANT_LIST)
+            && ((kid = cUNOPx(kid)->op_first))
+            && kid->op_type == OP_GV
+            && cGVOPx_gv(kid) == PL_defgv
+        )
+            flags |= AAS_DEFAV;
+    }
+
+    switch (o->op_type) {
+    case OP_GVSV:
+        (*scalars_p)++;
+        return AAS_PKG_SCALAR;
+
+    case OP_PADAV:
+    case OP_PADHV:
+        (*scalars_p) += 2;
+        if (top && (o->op_flags & OPf_REF))
+            return (o->op_private & OPpLVAL_INTRO)
+                ? AAS_MY_AGG : AAS_LEX_AGG;
+        return AAS_DANGEROUS;
+
+    case OP_PADSV:
+        {
+            int comm = S_aassign_padcheck(aTHX_ o, rhs)
+                        ?  AAS_LEX_SCALAR_COMM : 0;
+            (*scalars_p)++;
+            return (o->op_private & OPpLVAL_INTRO)
+                ? (AAS_MY_SCALAR|comm) : (AAS_LEX_SCALAR|comm);
+        }
+
+    case OP_RV2AV:
+    case OP_RV2HV:
+        (*scalars_p) += 2;
+        if (cUNOPx(o)->op_first->op_type != OP_GV)
+            return AAS_DANGEROUS; /* @{expr}, %{expr} */
+        /* @pkg, %pkg */
+        if (top && (o->op_flags & OPf_REF))
+            return AAS_PKG_AGG;
+        return AAS_DANGEROUS;
+
+    case OP_RV2SV:
+        (*scalars_p)++;
+        if (cUNOPx(o)->op_first->op_type != OP_GV) {
+            (*scalars_p) += 2;
+            return AAS_DANGEROUS; /* ${expr} */
+        }
+        return AAS_PKG_SCALAR; /* $pkg */
+
+    case OP_SPLIT:
+        if (cLISTOPo->op_first->op_type == OP_PUSHRE) {
+            /* "@foo = split... " optimises away the aassign and stores its
+             * destination array in the OP_PUSHRE that precedes it.
+             * A flattened array is always dangerous.
+             */
+            (*scalars_p) += 2;
+            return AAS_DANGEROUS;
+        }
+        break;
+
+    case OP_UNDEF:
+    case OP_PUSHMARK:
+    case OP_STUB:
+        /* these are all no-ops; they don't push a potentially common SV
+         * onto the stack, so they are neither AAS_DANGEROUS nor
+         * AAS_SAFE_SCALAR */
+        return 0;
+
+    case OP_PADRANGE: /* Ignore padrange; checking its siblings is enough */
+        break;
+
+    case OP_NULL:
+    case OP_LIST:
+        /* these do nothing but may have children; but their children
+         * should also be treated as top-level */
+        kid_top = top;
+        break;
+
+    default:
+        if (PL_opargs[o->op_type] & OA_DANGEROUS) {
+            (*scalars_p) += 2;
+            return AAS_DANGEROUS;
+        }
+
+        if (   (PL_opargs[o->op_type] & OA_TARGLEX)
+            && (o->op_private & OPpTARGET_MY))
+        {
+            (*scalars_p)++;
+            return S_aassign_padcheck(aTHX_ o, rhs)
+                ? AAS_LEX_SCALAR_COMM : AAS_LEX_SCALAR;
+        }
+
+        /* if its an unrecognised, non-dangerous op, assume that it
+         * it the cause of at least one safe scalar */
+        (*scalars_p)++;
+        flags = AAS_SAFE_SCALAR;
+        break;
+    }
+
+    if (o->op_flags & OPf_KIDS) {
+        OP *kid;
+        for (kid = cUNOPo->op_first; kid; kid = OpSIBLING(kid))
+            flags |= S_aassign_scan(aTHX_ kid, rhs, kid_top, scalars_p);
+    }
+    return flags;
+}
+
+
 /* Check for in place reverse and sort assignments like "@a = reverse @a"
    and modify the optree to make them work inplace */
 
@@ -13941,28 +14196,99 @@ Perl_rpeep(pTHX_ OP *o)
            }
            break;
 
-       case OP_AASSIGN:
-           /* We do the common-vars check here, rather than in newASSIGNOP
-              (as formerly), so that all lexical vars that get aliased are
-              marked as such before we do the check.  */
-           /* There can’t be common vars if the lhs is a stub.  */
-           if (OpSIBLING(cLISTOPx(cBINOPo->op_last)->op_first)
-                   == cLISTOPx(cBINOPo->op_last)->op_last
-            && cLISTOPx(cBINOPo->op_last)->op_last->op_type == OP_STUB)
-           {
-               o->op_private &=~ OPpASSIGN_COMMON;
-               break;
-           }
-           if (o->op_private & OPpASSIGN_COMMON) {
-                /* See the comment before S_aassign_common_vars concerning
-                   PL_generation sorcery.  */
-               PL_generation++;
-               if (!aassign_common_vars(o))
-                   o->op_private &=~ OPpASSIGN_COMMON;
-           }
-           else if (S_aassign_common_vars_aliases_only(aTHX_ o))
-               o->op_private |= OPpASSIGN_COMMON;
+       case OP_AASSIGN: {
+            int l, r, lr, lscalars, rscalars;
+
+            /* handle common vars detection, e.g. ($a,$b) = ($b,$a).
+               Note that we do this now rather than in newASSIGNOP(),
+               since only by now are aliased lexicals flagged as such
+
+               See the essay "Common vars in list assignment" above for
+               the full details of the rationale behind all the conditions
+               below.
+
+               PL_generation sorcery:
+               To detect whether there are common vars, the global var
+               PL_generation is incremented for each assign op we scan.
+               Then we run through all the lexical variables on the LHS,
+               of the assignment, setting a spare slot in each of them to
+               PL_generation.  Then we scan the RHS, and if any lexicals
+               already have that value, we know we've got commonality.
+               Also, if the generation number is already set to
+               PERL_INT_MAX, then the variable is involved in aliasing, so
+               we also have potential commonality in that case.
+             */
+
+            PL_generation++;
+            /* scan LHS */
+            lscalars = 0;
+            l = S_aassign_scan(aTHX_ cLISTOPo->op_last,  FALSE, 1, &lscalars);
+            /* scan RHS */
+            rscalars = 0;
+            r = S_aassign_scan(aTHX_ cLISTOPo->op_first, TRUE, 1, &rscalars);
+            lr = (l|r);
+
+
+            /* After looking for things which are *always* safe, this main
+             * if/else chain selects primarily based on the type of the
+             * LHS, gradually working its way down from the more dangerous
+             * to the more restrictive and thus safer cases */
+
+            if (   !l                      /* () = ....; */
+                || !r                      /* .... = (); */
+                || !(l & ~AAS_SAFE_SCALAR) /* (undef, pos()) = ...; */
+                || !(r & ~AAS_SAFE_SCALAR) /* ... = (1,2,length,undef); */
+                || (lscalars < 2)          /* ($x) = ... */
+            ) {
+                NOOP; /* always safe */
+            }
+            else if (l & AAS_DANGEROUS) {
+                /* always dangerous */
+                o->op_private |= OPpASSIGN_COMMON_SCALAR;
+                o->op_private |= OPpASSIGN_COMMON_AGG;
+            }
+            else if (l & (AAS_PKG_SCALAR|AAS_PKG_AGG)) {
+                /* package vars are always dangerous - too many
+                 * aliasing possibilities */
+                if (l & AAS_PKG_SCALAR)
+                    o->op_private |= OPpASSIGN_COMMON_SCALAR;
+                if (l & AAS_PKG_AGG)
+                    o->op_private |= OPpASSIGN_COMMON_AGG;
+            }
+            else if (l & ( AAS_MY_SCALAR|AAS_MY_AGG
+                          |AAS_LEX_SCALAR|AAS_LEX_AGG))
+            {
+                /* LHS contains only lexicals and safe ops */
+
+                if (l & (AAS_MY_AGG|AAS_LEX_AGG))
+                    o->op_private |= OPpASSIGN_COMMON_AGG;
+
+                if (l & (AAS_MY_SCALAR|AAS_LEX_SCALAR)) {
+                    if (lr & AAS_LEX_SCALAR_COMM)
+                        o->op_private |= OPpASSIGN_COMMON_SCALAR;
+                    else if (   !(l & AAS_LEX_SCALAR)
+                             && (r & AAS_DEFAV))
+                    {
+                        /* falsely mark
+                         *    my (...) = @_
+                         * as scalar-safe for performance reasons.
+                         * (it will still have been marked _AGG if necessary */
+                        NOOP;
+                    }
+                    else if (r  & (AAS_PKG_SCALAR|AAS_PKG_AGG|AAS_DANGEROUS))
+                        o->op_private |= OPpASSIGN_COMMON_RC1;
+                }
+            }
+
+            /* ... = ($x)
+             * may have to handle aggregate on LHS, but we can't
+             * have common scalars*/
+            if (rscalars < 2)
+                o->op_private &=
+                        ~(OPpASSIGN_COMMON_SCALAR|OPpASSIGN_COMMON_RC1);
+
            break;
+        }
 
        case OP_CUSTOM: {
            Perl_cpeep_t cpeep = 
diff --git a/opcode.h b/opcode.h
index d314035..d6fd683 100644
--- a/opcode.h
+++ b/opcode.h
@@ -2219,6 +2219,7 @@ END_EXTERN_C
 #define OPpSORT_INPLACE         0x08
 #define OPpTRANS_SQUASH         0x08
 #define OPpARG4_MASK            0x0f
+#define OPpASSIGN_COMMON_AGG    0x10
 #define OPpCONST_ENTERED        0x10
 #define OPpDEREF_AV             0x10
 #define OPpEVAL_COPHH           0x10
@@ -2230,6 +2231,7 @@ END_EXTERN_C
 #define OPpSORT_DESCEND         0x10
 #define OPpSUBSTR_REPL_FIRST    0x10
 #define OPpTARGET_MY            0x10
+#define OPpASSIGN_COMMON_RC1    0x20
 #define OPpDEREF_HV             0x20
 #define OPpEARLY_CV             0x20
 #define OPpEVAL_RE_REPARSING    0x20
@@ -2247,7 +2249,7 @@ END_EXTERN_C
 #define OPpLVREF_TYPE           0x30
 #define OPpALLOW_FAKE           0x40
 #define OPpASSIGN_BACKWARDS     0x40
-#define OPpASSIGN_COMMON        0x40
+#define OPpASSIGN_COMMON_SCALAR 0x40
 #define OPpCONST_BARE           0x40
 #define OPpCOREARGS_SCALARMOD   0x40
 #define OPpENTERSUB_DB          0x40
@@ -2310,8 +2312,10 @@ EXTCONST char PL_op_private_labels[] = {
     'B','O','O','L','\0',
     'B','O','O','L','?','\0',
     'B','Y','T','E','S','\0',
-    'C','O','M','M','O','N','\0',
     'C','O','M','P','L','\0',
+    'C','O','M','_','A','G','G','\0',
+    'C','O','M','_','R','C','1','\0',
+    'C','O','M','_','S','C','A','L','A','R','\0',
     'C','O','N','S','T','\0',
     'C','O','P','H','H','\0',
     'C','V','\0',
@@ -2405,8 +2409,8 @@ EXTCONST I16 PL_op_private_bitfields[] = {
     0, 8, -1,
     0, 8, -1,
     0, 8, -1,
-    4, -1, 1, 137, 2, 144, 3, 151, -1,
-    4, -1, 0, 495, 1, 26, 2, 264, 3, 83, -1,
+    4, -1, 1, 157, 2, 164, 3, 171, -1,
+    4, -1, 0, 515, 1, 26, 2, 284, 3, 103, -1,
 
 };
 
@@ -2456,8 +2460,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       68, /* aassign */
        0, /* chop */
        0, /* schop */
-      71, /* chomp */
-      71, /* schomp */
+      73, /* chomp */
+      73, /* schomp */
        0, /* defined */
        0, /* undef */
        0, /* study */
@@ -2470,22 +2474,22 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* i_postinc */
        0, /* postdec */
        0, /* i_postdec */
-      73, /* pow */
-      73, /* multiply */
-      73, /* i_multiply */
-      73, /* divide */
-      73, /* i_divide */
-      73, /* modulo */
-      73, /* i_modulo */
-      75, /* repeat */
-      73, /* add */
-      73, /* i_add */
-      73, /* subtract */
-      73, /* i_subtract */
-      73, /* concat */
-      77, /* stringify */
-      73, /* left_shift */
-      73, /* right_shift */
+      75, /* pow */
+      75, /* multiply */
+      75, /* i_multiply */
+      75, /* divide */
+      75, /* i_divide */
+      75, /* modulo */
+      75, /* i_modulo */
+      77, /* repeat */
+      75, /* add */
+      75, /* i_add */
+      75, /* subtract */
+      75, /* i_subtract */
+      75, /* concat */
+      79, /* stringify */
+      75, /* left_shift */
+      75, /* right_shift */
       12, /* lt */
       12, /* i_lt */
       12, /* gt */
@@ -2510,9 +2514,9 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       12, /* bit_and */
       12, /* bit_xor */
       12, /* bit_or */
-      73, /* nbit_and */
-      73, /* nbit_xor */
-      73, /* nbit_or */
+      75, /* nbit_and */
+      75, /* nbit_xor */
+      75, /* nbit_or */
       12, /* sbit_and */
       12, /* sbit_xor */
       12, /* sbit_or */
@@ -2520,110 +2524,110 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* i_negate */
        0, /* not */
        0, /* complement */
-      71, /* ncomplement */
-      71, /* scomplement */
+      73, /* ncomplement */
+      73, /* scomplement */
       12, /* smartmatch */
-      77, /* atan2 */
-      71, /* sin */
-      71, /* cos */
-      77, /* rand */
-      77, /* srand */
-      71, /* exp */
-      71, /* log */
-      71, /* sqrt */
-      71, /* int */
-      71, /* hex */
-      71, /* oct */
-      71, /* abs */
-      71, /* length */
-      79, /* substr */
-      82, /* vec */
-      77, /* index */
-      77, /* rindex */
+      79, /* atan2 */
+      73, /* sin */
+      73, /* cos */
+      79, /* rand */
+      79, /* srand */
+      73, /* exp */
+      73, /* log */
+      73, /* sqrt */
+      73, /* int */
+      73, /* hex */
+      73, /* oct */
+      73, /* abs */
+      73, /* length */
+      81, /* substr */
+      84, /* vec */
+      79, /* index */
+      79, /* rindex */
       49, /* sprintf */
       49, /* formline */
-      71, /* ord */
-      71, /* chr */
-      77, /* crypt */
+      73, /* ord */
+      73, /* chr */
+      79, /* crypt */
        0, /* ucfirst */
        0, /* lcfirst */
        0, /* uc */
        0, /* lc */
        0, /* quotemeta */
-      84, /* rv2av */
-      90, /* aelemfast */
-      90, /* aelemfast_lex */
-      91, /* aelem */
-      96, /* aslice */
-      99, /* kvaslice */
+      86, /* rv2av */
+      92, /* aelemfast */
+      92, /* aelemfast_lex */
+      93, /* aelem */
+      98, /* aslice */
+     101, /* kvaslice */
        0, /* aeach */
        0, /* akeys */
        0, /* avalues */
        0, /* each */
        0, /* values */
       40, /* keys */
-     100, /* delete */
-     103, /* exists */
-     105, /* rv2hv */
-      91, /* helem */
-      96, /* hslice */
-      99, /* kvhslice */
-     113, /* multideref */
+     102, /* delete */
+     105, /* exists */
+     107, /* rv2hv */
+      93, /* helem */
+      98, /* hslice */
+     101, /* kvhslice */
+     115, /* multideref */
       49, /* unpack */
       49, /* pack */
-     120, /* split */
+     122, /* split */
       49, /* join */
-     122, /* list */
+     124, /* list */
       12, /* lslice */
       49, /* anonlist */
       49, /* anonhash */
       49, /* splice */
-      77, /* push */
+      79, /* push */
        0, /* pop */
        0, /* shift */
-      77, /* unshift */
-     124, /* sort */
-     131, /* reverse */
-     133, /* grepstart */
-     133, /* grepwhile */
-     133, /* mapstart */
-     133, /* mapwhile */
+      79, /* unshift */
+     126, /* sort */
+     133, /* reverse */
+     135, /* grepstart */
+     135, /* grepwhile */
+     135, /* mapstart */
+     135, /* mapwhile */
        0, /* range */
-     135, /* flip */
-     135, /* flop */
+     137, /* flip */
+     137, /* flop */
        0, /* and */
        0, /* or */
       12, /* xor */
        0, /* dor */
-     137, /* cond_expr */
+     139, /* cond_expr */
        0, /* andassign */
        0, /* orassign */
        0, /* dorassign */
        0, /* method */
-     139, /* entersub */
-     146, /* leavesub */
-     146, /* leavesublv */
-     148, /* caller */
+     141, /* entersub */
+     148, /* leavesub */
+     148, /* leavesublv */
+     150, /* caller */
       49, /* warn */
       49, /* die */
       49, /* reset */
       -1, /* lineseq */
-     150, /* nextstate */
-     150, /* dbstate */
+     152, /* nextstate */
+     152, /* dbstate */
       -1, /* unstack */
       -1, /* enter */
-     151, /* leave */
+     153, /* leave */
       -1, /* scope */
-     153, /* enteriter */
-     157, /* iter */
+     155, /* enteriter */
+     159, /* iter */
       -1, /* enterloop */
-     158, /* leaveloop */
+     160, /* leaveloop */
       -1, /* return */
-     160, /* last */
-     160, /* next */
-     160, /* redo */
-     160, /* dump */
-     160, /* goto */
+     162, /* last */
+     162, /* next */
+     162, /* redo */
+     162, /* dump */
+     162, /* goto */
       49, /* exit */
        0, /* method_named */
        0, /* method_super */
@@ -2635,7 +2639,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* leavewhen */
       -1, /* break */
       -1, /* continue */
-     162, /* open */
+     164, /* open */
       49, /* close */
       49, /* pipe_op */
       49, /* fileno */
@@ -2651,7 +2655,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       49, /* getc */
       49, /* read */
       49, /* enterwrite */
-     146, /* leavewrite */
+     148, /* leavewrite */
       -1, /* prtf */
       -1, /* print */
       -1, /* say */
@@ -2665,7 +2669,7 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
       49, /* truncate */
       49, /* fcntl */
       49, /* ioctl */
-      77, /* flock */
+      79, /* flock */
       49, /* send */
       49, /* recv */
       49, /* socket */
@@ -2681,45 +2685,45 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* getpeername */
        0, /* lstat */
        0, /* stat */
-     167, /* ftrread */
-     167, /* ftrwrite */
-     167, /* ftrexec */
-     167, /* fteread */
-     167, /* ftewrite */
-     167, /* fteexec */
-     172, /* ftis */
-     172, /* ftsize */
-     172, /* ftmtime */
-     172, /* ftatime */
-     172, /* ftctime */
-     172, /* ftrowned */
-     172, /* fteowned */
-     172, /* ftzero */
-     172, /* ftsock */
-     172, /* ftchr */
-     172, /* ftblk */
-     172, /* ftfile */
-     172, /* ftdir */
-     172, /* ftpipe */
-     172, /* ftsuid */
-     172, /* ftsgid */
-     172, /* ftsvtx */
-     172, /* ftlink */
-     172, /* fttty */
-     172, /* fttext */
-     172, /* ftbinary */
-      77, /* chdir */
-      77, /* chown */
-      71, /* chroot */
-      77, /* unlink */
-      77, /* chmod */
-      77, /* utime */
-      77, /* rename */
-      77, /* link */
-      77, /* symlink */
+     169, /* ftrread */
+     169, /* ftrwrite */
+     169, /* ftrexec */
+     169, /* fteread */
+     169, /* ftewrite */
+     169, /* fteexec */
+     174, /* ftis */
+     174, /* ftsize */
+     174, /* ftmtime */
+     174, /* ftatime */
+     174, /* ftctime */
+     174, /* ftrowned */
+     174, /* fteowned */
+     174, /* ftzero */
+     174, /* ftsock */
+     174, /* ftchr */
+     174, /* ftblk */
+     174, /* ftfile */
+     174, /* ftdir */
+     174, /* ftpipe */
+     174, /* ftsuid */
+     174, /* ftsgid */
+     174, /* ftsvtx */
+     174, /* ftlink */
+     174, /* fttty */
+     174, /* fttext */
+     174, /* ftbinary */
+      79, /* chdir */
+      79, /* chown */
+      73, /* chroot */
+      79, /* unlink */
+      79, /* chmod */
+      79, /* utime */
+      79, /* rename */
+      79, /* link */
+      79, /* symlink */
        0, /* readlink */
-      77, /* mkdir */
-      71, /* rmdir */
+      79, /* mkdir */
+      73, /* rmdir */
       49, /* open_dir */
        0, /* readdir */
        0, /* telldir */
@@ -2727,22 +2731,22 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* rewinddir */
        0, /* closedir */
       -1, /* fork */
-     176, /* wait */
-      77, /* waitpid */
-      77, /* system */
-      77, /* exec */
-      77, /* kill */
-     176, /* getppid */
-      77, /* getpgrp */
-      77, /* setpgrp */
-      77, /* getpriority */
-      77, /* setpriority */
-     176, /* time */
+     178, /* wait */
+      79, /* waitpid */
+      79, /* system */
+      79, /* exec */
+      79, /* kill */
+     178, /* getppid */
+      79, /* getpgrp */
+      79, /* setpgrp */
+      79, /* getpriority */
+      79, /* setpriority */
+     178, /* time */
       -1, /* tms */
        0, /* localtime */
       49, /* gmtime */
        0, /* alarm */
-      77, /* sleep */
+      79, /* sleep */
       49, /* shmget */
       49, /* shmctl */
       49, /* shmread */
@@ -2757,8 +2761,8 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* require */
        0, /* dofile */
       -1, /* hintseval */
-     177, /* entereval */
-     146, /* leaveeval */
+     179, /* entereval */
+     148, /* leaveeval */
        0, /* entertry */
       -1, /* leavetry */
        0, /* ghbyname */
@@ -2796,17 +2800,17 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
        0, /* lock */
        0, /* once */
       -1, /* custom */
-     183, /* coreargs */
+     185, /* coreargs */
        3, /* runcv */
        0, /* fc */
       -1, /* padcv */
       -1, /* introcv */
       -1, /* clonecv */
-     187, /* padrange */
-     189, /* refassign */
-     195, /* lvref */
-     201, /* lvrefslice */
-     202, /* lvavref */
+     189, /* padrange */
+     191, /* refassign */
+     197, /* lvref */
+     203, /* lvrefslice */
+     204, /* lvavref */
        0, /* anonconst */
 
 };
@@ -2827,68 +2831,68 @@ EXTCONST I16  PL_op_private_bitdef_ix[] = {
 
 EXTCONST U16  PL_op_private_bitdefs[] = {
     0x0003, /* scalar, prototype, refgen, srefgen, ref, readline, regcmaybe, 
regcreset, regcomp, chop, schop, defined, undef, study, preinc, i_preinc, 
predec, i_predec, postinc, i_postinc, postdec, i ... [586 chars truncated]
-    0x29dc, 0x3bd9, /* pushmark */
+    0x2c5c, 0x3e59, /* pushmark */
     0x00bd, /* wantarray, runcv */
-    0x03b8, 0x1570, 0x3c8c, 0x3748, 0x2da5, /* const */
-    0x29dc, 0x2ef9, /* gvsv */
-    0x13d5, /* gv */
+    0x03b8, 0x17f0, 0x3f0c, 0x39c8, 0x3025, /* const */
**** PATCH TRUNCATED AT 2000 LINES -- 1659 NOT SHOWN ****

--
Perl5 Master Repository

Reply via email to