X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/87ebf1e3df9537a204b21f0405c6e60f2acdcc47..61b16eb90f32a2433d6de43e477a03b8d9fed039:/op.c

diff --git a/op.c b/op.c
index 2a76ae4..72c6809 100644
--- a/op.c
+++ b/op.c
@@ -297,9 +297,11 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     DEBUG_S_warn((aTHX_ "allocating op at %p, slab %p", (void*)o, (void*)slab));
 
   gotit:
-    /* lastsib == 1, op_sibling == 0 implies a solitary unattached op */
-    o->op_lastsib = 1;
-    assert(!o->op_sibling);
+#ifdef PERL_OP_PARENT
+    /* moresib == 0, op_sibling == 0 implies a solitary unattached op */
+    assert(!o->op_moresib);
+    assert(!o->op_sibparent);
+#endif
 
     return (void *)o;
 }
@@ -400,7 +402,7 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
     PERL_UNUSED_CONTEXT;
     DEBUG_S_warn((aTHX_ "freeing slab %p", (void*)slab));
     assert(slab->opslab_refcnt == 1);
-    for (; slab; slab = slab2) {
+    do {
 	slab2 = slab->opslab_next;
 #ifdef DEBUGGING
 	slab->opslab_refcnt = ~(size_t)0;
@@ -415,7 +417,8 @@ Perl_opslab_free(pTHX_ OPSLAB *slab)
 #else
 	PerlMemShared_free(slab);
 #endif
-    }
+        slab = slab2;
+    } while (slab);
 }
 
 void
@@ -507,7 +510,7 @@ Perl_op_refcnt_dec(pTHX_ OP *o)
 
 #define RETURN_UNLIMITED_NUMBER (PERL_INT_MAX / 2)
 
-#define CHANGE_TYPE(o,type) \
+#define OpTYPE_set(o,type) \
     STMT_START {				\
 	o->op_type = (OPCODE)type;		\
 	o->op_ppaddr = PL_ppaddr[type];		\
@@ -1180,7 +1183,7 @@ Perl_op_null(pTHX_ OP *o)
 	return;
     op_clear(o);
     o->op_targ = o->op_type;
-    CHANGE_TYPE(o, OP_NULL);
+    OpTYPE_set(o, OP_NULL);
 }
 
 void
@@ -1208,32 +1211,33 @@ Perl_op_refcnt_unlock(pTHX)
 =for apidoc op_sibling_splice
 
 A general function for editing the structure of an existing chain of
-op_sibling nodes.  By analogy with the perl-level splice() function, allows
+op_sibling nodes.  By analogy with the perl-level C<splice()> function, allows
 you to delete zero or more sequential nodes, replacing them with zero or
 more different nodes.  Performs the necessary op_first/op_last
 housekeeping on the parent node and op_sibling manipulation on the
 children.  The last deleted node will be marked as as the last node by
-updating the op_sibling or op_lastsib field as appropriate.
+updating the op_sibling/op_sibparent or op_moresib field as appropriate.
 
 Note that op_next is not manipulated, and nodes are not freed; that is the
 responsibility of the caller.  It also won't create a new list op for an
 empty list etc; use higher-level functions like op_append_elem() for that.
 
-parent is the parent node of the sibling chain.
+C<parent> is the parent node of the sibling chain. It may passed as C<NULL> if
+the splicing doesn't affect the first or last op in the chain.
 
-start is the node preceding the first node to be spliced.  Node(s)
+C<start> is the node preceding the first node to be spliced.  Node(s)
 following it will be deleted, and ops will be inserted after it.  If it is
-NULL, the first node onwards is deleted, and nodes are inserted at the
+C<NULL>, the first node onwards is deleted, and nodes are inserted at the
 beginning.
 
-del_count is the number of nodes to delete.  If zero, no nodes are deleted.
+C<del_count> is the number of nodes to delete.  If zero, no nodes are deleted.
 If -1 or greater than or equal to the number of remaining kids, all
 remaining kids are deleted.
 
-insert is the first of a chain of nodes to be inserted in place of the nodes.
-If NULL, no nodes are inserted.
+C<insert> is the first of a chain of nodes to be inserted in place of the nodes.
+If C<NULL>, no nodes are inserted.
 
-The head of the chain of deleted ops is returned, or NULL if no ops were
+The head of the chain of deleted ops is returned, or C<NULL> if no ops were
 deleted.
 
 For example:
@@ -1257,18 +1261,27 @@ For example:
     splice(P, B, 0, X-Y)      |           |             NULL
                               A-B-C-D     A-B-X-Y-C-D
 
+
+For lower-level direct manipulation of C<op_sibparent> and C<op_moresib>,
+see C<L</OpMORESIB_set>>, C<L</OpLASTSIB_set>>, C<L</OpMAYBESIB_set>>.
+
 =cut
 */
 
 OP *
 Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
 {
-    OP *first = start ? OpSIBLING(start) : cLISTOPx(parent)->op_first;
+    OP *first;
     OP *rest;
     OP *last_del = NULL;
     OP *last_ins = NULL;
 
-    PERL_ARGS_ASSERT_OP_SIBLING_SPLICE;
+    if (start)
+        first = OpSIBLING(start);
+    else if (!parent)
+        goto no_parent;
+    else
+        first = cLISTOPx(parent)->op_first;
 
     assert(del_count >= -1);
 
@@ -1277,8 +1290,7 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
         while (--del_count && OpHAS_SIBLING(last_del))
             last_del = OpSIBLING(last_del);
         rest = OpSIBLING(last_del);
-        OpSIBLING_set(last_del, NULL);
-        last_del->op_lastsib = 1;
+        OpLASTSIB_set(last_del, NULL);
     }
     else
         rest = first;
@@ -1287,17 +1299,17 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
         last_ins = insert;
         while (OpHAS_SIBLING(last_ins))
             last_ins = OpSIBLING(last_ins);
-        OpSIBLING_set(last_ins, rest);
-        last_ins->op_lastsib = rest ? 0 : 1;
+        OpMAYBESIB_set(last_ins, rest, NULL);
     }
     else
         insert = rest;
 
     if (start) {
-        OpSIBLING_set(start, insert);
-        start->op_lastsib = insert ? 0 : 1;
+        OpMAYBESIB_set(start, insert, NULL);
     }
     else {
+        if (!parent)
+            goto no_parent;
         cLISTOPx(parent)->op_first = insert;
         if (insert)
             parent->op_flags |= OPf_KIDS;
@@ -1307,12 +1319,25 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
 
     if (!rest) {
         /* update op_last etc */
-        U32 type = parent->op_type;
+        U32 type;
         OP *lastop;
 
-        if (type == OP_NULL)
-            type = parent->op_targ;
-        type = PL_opargs[type] & OA_CLASS_MASK;
+        if (!parent)
+            goto no_parent;
+
+        /* ought to use OP_CLASS(parent) here, but that can't handle
+         * ex-foo OP_NULL ops. Also note that XopENTRYCUSTOM() can't
+         * either */
+        type = parent->op_type;
+        if (type == OP_CUSTOM) {
+            dTHX;
+            type = XopENTRYCUSTOM(parent, xop_class);
+        }
+        else {
+            if (type == OP_NULL)
+                type = parent->op_targ;
+            type = PL_opargs[type] & OA_CLASS_MASK;
+        }
 
         lastop = last_ins ? last_ins : start ? start : NULL;
         if (   type == OA_BINOP
@@ -1322,22 +1347,23 @@ Perl_op_sibling_splice(OP *parent, OP *start, int del_count, OP* insert)
         )
             cLISTOPx(parent)->op_last = lastop;
 
-        if (lastop) {
-            lastop->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
-            lastop->op_sibling = parent;
-#endif
-        }
+        if (lastop)
+            OpLASTSIB_set(lastop, parent);
     }
     return last_del ? first : NULL;
+
+  no_parent:
+    Perl_croak_nocontext("panic: op_sibling_splice(): NULL parent");
 }
 
+
+#ifdef PERL_OP_PARENT
+
 /*
 =for apidoc op_parent
 
-returns the parent OP of o, if it has a parent.  Returns NULL otherwise.
-(Currently perl must be built with C<-DPERL_OP_PARENT> for this feature to
-work.
+Returns the parent OP of C<o>, if it has a parent. Returns C<NULL> otherwise.
+This function is only available on perls built with C<-DPERL_OP_PARENT>.
 
 =cut
 */
@@ -1346,16 +1372,13 @@ OP *
 Perl_op_parent(OP *o)
 {
     PERL_ARGS_ASSERT_OP_PARENT;
-#ifdef PERL_OP_PARENT
     while (OpHAS_SIBLING(o))
         o = OpSIBLING(o);
-    return o->op_sibling;
-#else
-    PERL_UNUSED_ARG(o);
-    return NULL;
-#endif
+    return o->op_sibparent;
 }
 
+#endif
+
 
 /* replace the sibling following start with a new UNOP, which becomes
  * the parent of the original sibling; e.g.
@@ -1401,18 +1424,14 @@ S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
     LOGOP *logop;
     OP *kid = first;
     NewOp(1101, logop, 1, LOGOP);
-    CHANGE_TYPE(logop, type);
+    OpTYPE_set(logop, type);
     logop->op_first = first;
     logop->op_other = other;
     logop->op_flags = OPf_KIDS;
     while (kid && OpHAS_SIBLING(kid))
         kid = OpSIBLING(kid);
-    if (kid) {
-        kid->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
-        kid->op_sibling = (OP*)logop;
-#endif
-    }
+    if (kid)
+        OpLASTSIB_set(kid, (OP*)logop);
     return logop;
 }
 
@@ -1423,7 +1442,7 @@ S_alloc_LOGOP(pTHX_ I32 type, OP *first, OP* other)
 =for apidoc Am|OP *|op_contextualize|OP *o|I32 context
 
 Applies a syntactic context to an op tree representing an expression.
-I<o> is the op tree, and I<context> must be C<G_SCALAR>, C<G_ARRAY>,
+C<o> is the op tree, and C<context> must be C<G_SCALAR>, C<G_ARRAY>,
 or C<G_VOID> to specify the context to apply.  The modified op tree
 is returned.
 
@@ -1601,9 +1620,6 @@ S_scalar_slice_warning(pTHX_ const OP *o)
     case OP_LOCALTIME:
     case OP_GMTIME:
     case OP_ENTEREVAL:
-    case OP_REACH:
-    case OP_RKEYS:
-    case OP_RVALUES:
 	return;
     }
 
@@ -1970,19 +1986,19 @@ Perl_scalarvoid(pTHX_ OP *arg)
             break;
 
         case OP_POSTINC:
-            CHANGE_TYPE(o, OP_PREINC);  /* pre-increment is faster */
+            OpTYPE_set(o, OP_PREINC);  /* pre-increment is faster */
             break;
 
         case OP_POSTDEC:
-            CHANGE_TYPE(o, OP_PREDEC);  /* pre-decrement is faster */
+            OpTYPE_set(o, OP_PREDEC);  /* pre-decrement is faster */
             break;
 
         case OP_I_POSTINC:
-            CHANGE_TYPE(o, OP_I_PREINC);        /* pre-increment is faster */
+            OpTYPE_set(o, OP_I_PREINC);        /* pre-increment is faster */
             break;
 
         case OP_I_POSTDEC:
-            CHANGE_TYPE(o, OP_I_PREDEC);        /* pre-decrement is faster */
+            OpTYPE_set(o, OP_I_PREDEC);        /* pre-decrement is faster */
             break;
 
         case OP_SASSIGN: {
@@ -2039,9 +2055,9 @@ Perl_scalarvoid(pTHX_ OP *arg)
             if (kid->op_type == OP_NOT
                 && (kid->op_flags & OPf_KIDS)) {
                 if (o->op_type == OP_AND) {
-                    CHANGE_TYPE(o, OP_OR);
+                    OpTYPE_set(o, OP_OR);
                 } else {
-                    CHANGE_TYPE(o, OP_AND);
+                    OpTYPE_set(o, OP_AND);
                 }
                 op_null(kid);
             }
@@ -2349,7 +2365,7 @@ S_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op)
 
 This function finalizes the optree.  Should be called directly after
 the complete optree is built.  It does some additional
-checking which can't be done in the normal ck_xxx functions and makes
+checking which can't be done in the normal C<ck_>xxx functions and makes
 the tree thread-safe.
 
 =cut
@@ -2509,9 +2525,9 @@ S_finalize_op(pTHX_ OP* o)
 
 #ifdef DEBUGGING
         /* check that op_last points to the last sibling, and that
-         * the last op_sibling field points back to the parent, and
-         * that the only ops with KIDS are those which are entitled to
-         * them */
+         * the last op_sibling/op_sibparent field points back to the
+         * parent, and that the only ops with KIDS are those which are
+         * entitled to them */
         U32 type = o->op_type;
         U32 family;
         bool has_last;
@@ -2550,17 +2566,11 @@ S_finalize_op(pTHX_ OP* o)
             if (!OpHAS_SIBLING(kid)) {
                 if (has_last)
                     assert(kid == cLISTOPo->op_last);
-                assert(kid->op_sibling == o);
+                assert(kid->op_sibparent == o);
             }
 #  else
-            if (OpHAS_SIBLING(kid)) {
-                assert(!kid->op_lastsib);
-            }
-            else {
-                assert(kid->op_lastsib);
-                if (has_last)
-                    assert(kid == cLISTOPo->op_last);
-            }
+            if (has_last && !OpHAS_SIBLING(kid))
+                assert(kid == cLISTOPo->op_last);
 #  endif
         }
 #endif
@@ -2574,14 +2584,14 @@ S_finalize_op(pTHX_ OP* o)
 =for apidoc Amx|OP *|op_lvalue|OP *o|I32 type
 
 Propagate lvalue ("modifiable") context to an op and its children.
-I<type> represents the context type, roughly based on the type of op that
-would do the modifying, although C<local()> is represented by OP_NULL,
+C<type> represents the context type, roughly based on the type of op that
+would do the modifying, although C<local()> is represented by C<OP_NULL>,
 because it has no op type of its own (it is signalled by a flag on
 the lvalue op).
 
 This function detects things that can't be modified, such as C<$x+1>, and
 generates errors for them.  For example, C<$x+1 = 2> would cause it to be
-called with an op of type OP_ADD and a C<type> argument of OP_SASSIGN.
+called with an op of type C<OP_ADD> and a C<type> argument of C<OP_SASSIGN>.
 
 It also flags things that need to behave specially in an lvalue context,
 such as C<$$x = 5> which might have to vivify a reference in C<$x>.
@@ -2643,7 +2653,7 @@ S_lvref(pTHX_ OP *o, I32 type)
 		return;
 	    }
 	  slurpy:
-            CHANGE_TYPE(o, OP_LVAVREF);
+            OpTYPE_set(o, OP_LVAVREF);
 	    o->op_private &= OPpLVAL_INTRO|OPpPAD_STATE;
 	    o->op_flags |= OPf_MOD|OPf_REF;
 	    return;
@@ -2653,7 +2663,7 @@ S_lvref(pTHX_ OP *o, I32 type)
     case OP_RV2CV:
 	kid = cUNOPo->op_first;
 	if (kid->op_type == OP_NULL)
-	    kid = cUNOPx(kUNOP->op_first->op_sibling)
+	    kid = cUNOPx(OpSIBLING(kUNOP->op_first))
 		->op_first;
 	o->op_private = OPpLVREF_CV;
 	if (kid->op_type == OP_GV)
@@ -2700,7 +2710,7 @@ S_lvref(pTHX_ OP *o, I32 type)
 	break;
     case OP_ASLICE:
     case OP_HSLICE:
-        CHANGE_TYPE(o, OP_LVREFSLICE);
+        OpTYPE_set(o, OP_LVREFSLICE);
 	o->op_private &= OPpLVAL_INTRO|OPpLVREF_ELEM;
 	return;
     case OP_NULL:
@@ -2731,9 +2741,8 @@ S_lvref(pTHX_ OP *o, I32 type)
 		      ? "do block"
 		      : OP_DESC(o),
 		     PL_op_desc[type]));
-	return;
     }
-    CHANGE_TYPE(o, OP_LVREF);
+    OpTYPE_set(o, OP_LVREF);
     o->op_private &=
 	OPpLVAL_INTRO|OPpLVREF_ELEM|OPpLVREF_TYPE|OPpPAD_STATE;
     if (type == OP_ENTERLOOP)
@@ -2772,7 +2781,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
     case OP_ENTERSUB:
 	if ((type == OP_UNDEF || type == OP_REFGEN || type == OP_LOCK) &&
 	    !(o->op_flags & OPf_STACKED)) {
-            CHANGE_TYPE(o, OP_RV2CV);		/* entersub => rv2cv */
+            OpTYPE_set(o, OP_RV2CV);		/* entersub => rv2cv */
 	    assert(cUNOPo->op_first->op_type == OP_NULL);
 	    op_null(((LISTOP*)cUNOPo->op_first)->op_first);/* disable pushmark */
 	    break;
@@ -2986,7 +2995,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 	break;
 
     case OP_KEYS:
-    case OP_RKEYS:
 	if (type != OP_SASSIGN && type != OP_LEAVESUBLV)
 	    goto nomod;
 	goto lvalue_func;
@@ -3237,14 +3245,14 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
 
     PERL_ARGS_ASSERT_DOREF;
 
-    if (!o || (PL_parser && PL_parser->error_count))
+    if (PL_parser && PL_parser->error_count)
 	return o;
 
     switch (o->op_type) {
     case OP_ENTERSUB:
 	if ((type == OP_EXISTS || type == OP_DEFINED) &&
 	    !(o->op_flags & OPf_STACKED)) {
-            CHANGE_TYPE(o, OP_RV2CV);             /* entersub => rv2cv */
+            OpTYPE_set(o, OP_RV2CV);             /* entersub => rv2cv */
 	    assert(cUNOPo->op_first->op_type == OP_NULL);
 	    op_null(((LISTOP*)cUNOPo->op_first)->op_first);	/* disable pushmark */
 	    o->op_flags |= OPf_SPECIAL;
@@ -3356,24 +3364,26 @@ S_dup_attrlist(pTHX_ OP *o)
 STATIC void
 S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs)
 {
-    SV * const stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
-
     PERL_ARGS_ASSERT_APPLY_ATTRS;
+    {
+        SV * const stashsv = newSVhek(HvNAME_HEK(stash));
 
-    /* fake up C<use attributes $pkg,$rv,@attrs> */
+        /* fake up C<use attributes $pkg,$rv,@attrs> */
 
 #define ATTRSMODULE "attributes"
 #define ATTRSMODULE_PM "attributes.pm"
 
-    Perl_load_module(aTHX_ PERL_LOADMOD_IMPORT_OPS,
-			 newSVpvs(ATTRSMODULE),
-			 NULL,
-			 op_prepend_elem(OP_LIST,
-				      newSVOP(OP_CONST, 0, stashsv),
-				      op_prepend_elem(OP_LIST,
-						   newSVOP(OP_CONST, 0,
-							   newRV(target)),
-						   dup_attrlist(attrs))));
+        Perl_load_module(
+          aTHX_ PERL_LOADMOD_IMPORT_OPS,
+          newSVpvs(ATTRSMODULE),
+          NULL,
+          op_prepend_elem(OP_LIST,
+                          newSVOP(OP_CONST, 0, stashsv),
+                          op_prepend_elem(OP_LIST,
+                                          newSVOP(OP_CONST, 0,
+                                                  newRV(target)),
+                                          dup_attrlist(attrs))));
+    }
 }
 
 STATIC void
@@ -3404,7 +3414,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
     pack = newSVOP(OP_CONST, 0, newSVpvs(ATTRSMODULE));
 
     /* Build up the real arg-list. */
-    stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
+    stashsv = newSVhek(HvNAME_HEK(stash));
 
     arg = newOP(OP_PADSV, 0);
     arg->op_targ = target->op_targ;
@@ -3412,7 +3422,7 @@ S_apply_attrs_my(pTHX_ HV *stash, OP *target, OP *attrs, OP **imopsp)
 		       newSVOP(OP_CONST, 0, stashsv),
 		       op_prepend_elem(OP_LIST,
 				    newUNOP(OP_REFGEN, 0,
-					    op_lvalue(arg, OP_REFGEN)),
+					    arg),
 				    dup_attrlist(attrs)));
 
     /* Fake up a method call to import */
@@ -3827,11 +3837,11 @@ Perl_op_scope(pTHX_ OP *o)
     if (o) {
 	if (o->op_flags & OPf_PARENS || PERLDB_NOOPT || TAINTING_get) {
 	    o = op_prepend_elem(OP_LINESEQ, newOP(OP_ENTER, 0), o);
-            CHANGE_TYPE(o, OP_LEAVE);
+            OpTYPE_set(o, OP_LEAVE);
 	}
 	else if (o->op_type == OP_LINESEQ) {
 	    OP *kid;
-            CHANGE_TYPE(o, OP_SCOPE);
+            OpTYPE_set(o, OP_SCOPE);
 	    kid = ((LISTOP*)o)->op_first;
 	    if (kid->op_type == OP_NEXTSTATE || kid->op_type == OP_DBSTATE) {
 		op_null(kid);
@@ -3895,9 +3905,9 @@ Perl_block_start(pTHX_ int full)
 /*
 =for apidoc Am|OP *|block_end|I32 floor|OP *seq
 
-Handles compile-time scope exit.  I<floor>
+Handles compile-time scope exit.  C<floor>
 is the savestack index returned by
-C<block_start>, and I<seq> is the body of the block.  Returns the block,
+C<block_start>, and C<seq> is the body of the block.  Returns the block,
 possibly modified.
 
 =cut
@@ -4414,7 +4424,7 @@ S_gen_constant_list(pTHX_ OP *o)
     Perl_pp_anonlist(aTHX);
     PL_tmps_floor = oldtmps_floor;
 
-    CHANGE_TYPE(o, OP_RV2AV);
+    OpTYPE_set(o, OP_RV2AV);
     o->op_flags &= ~OPf_REF;	/* treat \(1..2) like an ordinary list */
     o->op_flags |= OPf_PARENS;	/* and flatten \(1..2,3) */
     o->op_opt = 0;		/* needs to be revisited in rpeep() */
@@ -4445,10 +4455,10 @@ S_gen_constant_list(pTHX_ OP *o)
 =for apidoc Am|OP *|op_append_elem|I32 optype|OP *first|OP *last
 
 Append an item to the list of ops contained directly within a list-type
-op, returning the lengthened list.  I<first> is the list-type op,
-and I<last> is the op to append to the list.  I<optype> specifies the
-intended opcode for the list.  If I<first> is not already a list of the
-right type, it will be upgraded into one.  If either I<first> or I<last>
+op, returning the lengthened list.  C<first> is the list-type op,
+and C<last> is the op to append to the list.  C<optype> specifies the
+intended opcode for the list.  If C<first> is not already a list of the
+right type, it will be upgraded into one.  If either C<first> or C<last>
 is null, the other is returned unchanged.
 
 =cut
@@ -4478,10 +4488,10 @@ Perl_op_append_elem(pTHX_ I32 type, OP *first, OP *last)
 =for apidoc Am|OP *|op_append_list|I32 optype|OP *first|OP *last
 
 Concatenate the lists of ops contained directly within two list-type ops,
-returning the combined list.  I<first> and I<last> are the list-type ops
-to concatenate.  I<optype> specifies the intended opcode for the list.
-If either I<first> or I<last> is not already a list of the right type,
-it will be upgraded into one.  If either I<first> or I<last> is null,
+returning the combined list.  C<first> and C<last> are the list-type ops
+to concatenate.  C<optype> specifies the intended opcode for the list.
+If either C<first> or C<last> is not already a list of the right type,
+it will be upgraded into one.  If either C<first> or C<last> is null,
 the other is returned unchanged.
 
 =cut
@@ -4502,16 +4512,11 @@ Perl_op_append_list(pTHX_ I32 type, OP *first, OP *last)
     if (last->op_type != (unsigned)type)
 	return op_append_elem(type, first, last);
 
-    ((LISTOP*)first)->op_last->op_lastsib = 0;
-    OpSIBLING_set(((LISTOP*)first)->op_last, ((LISTOP*)last)->op_first);
+    OpMORESIB_set(((LISTOP*)first)->op_last, ((LISTOP*)last)->op_first);
     ((LISTOP*)first)->op_last = ((LISTOP*)last)->op_last;
-    ((LISTOP*)first)->op_last->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
-    ((LISTOP*)first)->op_last->op_sibling = first;
-#endif
+    OpLASTSIB_set(((LISTOP*)first)->op_last, first);
     first->op_flags |= (last->op_flags & OPf_KIDS);
 
-
     S_op_destroy(aTHX_ last);
 
     return first;
@@ -4521,10 +4526,10 @@ Perl_op_append_list(pTHX_ I32 type, OP *first, OP *last)
 =for apidoc Am|OP *|op_prepend_elem|I32 optype|OP *first|OP *last
 
 Prepend an item to the list of ops contained directly within a list-type
-op, returning the lengthened list.  I<first> is the op to prepend to the
-list, and I<last> is the list-type op.  I<optype> specifies the intended
-opcode for the list.  If I<last> is not already a list of the right type,
-it will be upgraded into one.  If either I<first> or I<last> is null,
+op, returning the lengthened list.  C<first> is the op to prepend to the
+list, and C<last> is the list-type op.  C<optype> specifies the intended
+opcode for the list.  If C<last> is not already a list of the right type,
+it will be upgraded into one.  If either C<first> or C<last> is null,
 the other is returned unchanged.
 
 =cut
@@ -4558,8 +4563,8 @@ Perl_op_prepend_elem(pTHX_ I32 type, OP *first, OP *last)
 /*
 =for apidoc Am|OP *|op_convert_list|I32 type|I32 flags|OP *o
 
-Converts I<o> into a list op if it is not one already, and then converts it
-into the specified I<type>, calling its check function, allocating a target if
+Converts C<o> into a list op if it is not one already, and then converts it
+into the specified C<type>, calling its check function, allocating a target if
 it needs one, and folding constants.
 
 A list-type op is usually constructed one kid at a time via C<newLISTOP>,
@@ -4577,7 +4582,10 @@ Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
     if (!o || o->op_type != OP_LIST)
         o = force_list(o, 0);
     else
+    {
 	o->op_flags &= ~OPf_WANT;
+	o->op_private &= ~OPpLVAL_INTRO;
+    }
 
     if (!(PL_opargs[type] & OA_MARK))
 	op_null(cLISTOPo->op_first);
@@ -4589,7 +4597,7 @@ Perl_op_convert_list(pTHX_ I32 type, I32 flags, OP *o)
 	}
     }
 
-    CHANGE_TYPE(o, type);
+    OpTYPE_set(o, type);
     o->op_flags |= flags;
     if (flags & OPf_FOLDED)
 	o->op_folded = 1;
@@ -4642,8 +4650,7 @@ S_force_list(pTHX_ OP *o, bool nullit)
         if (o) {
             /* manually detach any siblings then add them back later */
             rest = OpSIBLING(o);
-            OpSIBLING_set(o, NULL);
-            o->op_lastsib = 1;
+            OpLASTSIB_set(o, NULL);
         }
 	o = newLISTOP(OP_LIST, 0, o, NULL);
         if (rest)
@@ -4657,16 +4664,16 @@ S_force_list(pTHX_ OP *o, bool nullit)
 /*
 =for apidoc Am|OP *|newLISTOP|I32 type|I32 flags|OP *first|OP *last
 
-Constructs, checks, and returns an op of any list type.  I<type> is
-the opcode.  I<flags> gives the eight bits of C<op_flags>, except that
-C<OPf_KIDS> will be set automatically if required.  I<first> and I<last>
+Constructs, checks, and returns an op of any list type.  C<type> is
+the opcode.  C<flags> gives the eight bits of C<op_flags>, except that
+C<OPf_KIDS> will be set automatically if required.  C<first> and C<last>
 supply up to two ops to be direct children of the list op; they are
 consumed by this function and become part of the constructed op tree.
 
 For most list operators, the check function expects all the kid ops to be
-present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.,) is not
+present already, so calling C<newLISTOP(OP_JOIN, ...)> (e.g.) is not
 appropriate.  What you want to do in that case is create an op of type
-OP_LIST, append more children to it, and then call L</op_convert_list>.
+C<OP_LIST>, append more children to it, and then call L</op_convert_list>.
 See L</op_convert_list> for more information.
 
 
@@ -4684,7 +4691,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 
     NewOp(1101, listop, 1, LISTOP);
 
-    CHANGE_TYPE(listop, type);
+    OpTYPE_set(listop, type);
     if (first || last)
 	flags |= OPf_KIDS;
     listop->op_flags = (U8)flags;
@@ -4694,26 +4701,19 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     else if (!first && last)
 	first = last;
     else if (first)
-	OpSIBLING_set(first, last);
+	OpMORESIB_set(first, last);
     listop->op_first = first;
     listop->op_last = last;
     if (type == OP_LIST) {
 	OP* const pushop = newOP(OP_PUSHMARK, 0);
-        pushop->op_lastsib = 0;
-        OpSIBLING_set(pushop, first);
+	OpMORESIB_set(pushop, first);
 	listop->op_first = pushop;
 	listop->op_flags |= OPf_KIDS;
 	if (!last)
 	    listop->op_last = pushop;
     }
-    if (first)
-        first->op_lastsib = 0;
-    if (listop->op_last) {
-        listop->op_last->op_lastsib = 1;
-#ifdef PERL_OP_PARENT
-        listop->op_last->op_sibling = (OP*)listop;
-#endif
-    }
+    if (listop->op_last)
+        OpLASTSIB_set(listop->op_last, (OP*)listop);
 
     return CHECKOP(type, listop);
 }
@@ -4722,7 +4722,7 @@ Perl_newLISTOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
 =for apidoc Am|OP *|newOP|I32 type|I32 flags
 
 Constructs, checks, and returns an op of any base type (any type that
-has no extra fields).  I<type> is the opcode.  I<flags> gives the
+has no extra fields).  C<type> is the opcode.  C<flags> gives the
 eight bits of C<op_flags>, and, shifted up eight bits, the eight bits
 of C<op_private>.
 
@@ -4746,7 +4746,7 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
 	|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
 
     NewOp(1101, o, 1, OP);
-    CHANGE_TYPE(o, type);
+    OpTYPE_set(o, type);
     o->op_flags = (U8)flags;
 
     o->op_next = o;
@@ -4761,11 +4761,11 @@ Perl_newOP(pTHX_ I32 type, I32 flags)
 /*
 =for apidoc Am|OP *|newUNOP|I32 type|I32 flags|OP *first
 
-Constructs, checks, and returns an op of any unary type.  I<type> is
-the opcode.  I<flags> gives the eight bits of C<op_flags>, except that
+Constructs, checks, and returns an op of any unary type.  C<type> is
+the opcode.  C<flags> gives the eight bits of C<op_flags>, except that
 C<OPf_KIDS> will be set automatically if required, and, shifted up eight
 bits, the eight bits of C<op_private>, except that the bit with value 1
-is automatically set.  I<first> supplies an optional op to be the direct
+is automatically set.  C<first> supplies an optional op to be the direct
 child of the unary op; it is consumed by this function and become part
 of the constructed op tree.
 
@@ -4798,15 +4798,13 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 	first = force_list(first, 1);
 
     NewOp(1101, unop, 1, UNOP);
-    CHANGE_TYPE(unop, type);
+    OpTYPE_set(unop, type);
     unop->op_first = first;
     unop->op_flags = (U8)(flags | OPf_KIDS);
     unop->op_private = (U8)(1 | (flags >> 8));
 
-#ifdef PERL_OP_PARENT
     if (!OpHAS_SIBLING(first)) /* true unless weird syntax error */
-        first->op_sibling = (OP*)unop;
-#endif
+        OpLASTSIB_set(first, (OP*)unop);
 
     unop = (UNOP*) CHECKOP(type, unop);
     if (unop->op_next)
@@ -4818,8 +4816,8 @@ Perl_newUNOP(pTHX_ I32 type, I32 flags, OP *first)
 /*
 =for apidoc newUNOP_AUX
 
-Similar to C<newUNOP>, but creates an UNOP_AUX struct instead, with op_aux
-initialised to aux
+Similar to C<newUNOP>, but creates an C<UNOP_AUX> struct instead, with C<op_aux>
+initialised to C<aux>
 
 =cut
 */
@@ -4841,10 +4839,8 @@ Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux)
     unop->op_private = (U8)((first ? 1 : 0) | (flags >> 8));
     unop->op_aux = aux;
 
-#ifdef PERL_OP_PARENT
     if (first && !OpHAS_SIBLING(first)) /* true unless weird syntax error */
-        first->op_sibling = (OP*)unop;
-#endif
+        OpLASTSIB_set(first, (OP*)unop);
 
     unop = (UNOP_AUX*) CHECKOP(type, unop);
 
@@ -4855,13 +4851,13 @@ Perl_newUNOP_AUX(pTHX_ I32 type, I32 flags, OP *first, UNOP_AUX_item *aux)
 =for apidoc Am|OP *|newMETHOP|I32 type|I32 flags|OP *first
 
 Constructs, checks, and returns an op of method type with a method name
-evaluated at runtime.  I<type> is the opcode.  I<flags> gives the eight
+evaluated at runtime.  C<type> is the opcode.  C<flags> gives the eight
 bits of C<op_flags>, except that C<OPf_KIDS> will be set automatically,
 and, shifted up eight bits, the eight bits of C<op_private>, except that
-the bit with value 1 is automatically set.  I<dynamic_meth> supplies an
+the bit with value 1 is automatically set.  C<dynamic_meth> supplies an
 op which evaluates method name; it is consumed by this function and
 become part of the constructed op tree.
-Supported optypes: OP_METHOD.
+Supported optypes: C<OP_METHOD>.
 
 =cut
 */
@@ -4881,10 +4877,8 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth
         methop->op_u.op_first = dynamic_meth;
         methop->op_private = (U8)(1 | (flags >> 8));
 
-#ifdef PERL_OP_PARENT
         if (!OpHAS_SIBLING(dynamic_meth))
-            dynamic_meth->op_sibling = (OP*)methop;
-#endif
+            OpLASTSIB_set(dynamic_meth, (OP*)methop);
     }
     else {
         assert(const_meth);
@@ -4900,7 +4894,7 @@ S_newMETHOP_internal(pTHX_ I32 type, I32 flags, OP* dynamic_meth, SV* const_meth
     methop->op_rclass_sv = NULL;
 #endif
 
-    CHANGE_TYPE(methop, type);
+    OpTYPE_set(methop, type);
     return CHECKOP(type, methop);
 }
 
@@ -4914,11 +4908,11 @@ Perl_newMETHOP (pTHX_ I32 type, I32 flags, OP* dynamic_meth) {
 =for apidoc Am|OP *|newMETHOP_named|I32 type|I32 flags|SV *const_meth
 
 Constructs, checks, and returns an op of method type with a constant
-method name.  I<type> is the opcode.  I<flags> gives the eight bits of
+method name.  C<type> is the opcode.  C<flags> gives the eight bits of
 C<op_flags>, and, shifted up eight bits, the eight bits of
-C<op_private>.  I<const_meth> supplies a constant method name;
+C<op_private>.  C<const_meth> supplies a constant method name;
 it must be a shared COW string.
-Supported optypes: OP_METHOD_NAMED.
+Supported optypes: C<OP_METHOD_NAMED>.
 
 =cut
 */
@@ -4932,11 +4926,11 @@ Perl_newMETHOP_named (pTHX_ I32 type, I32 flags, SV* const_meth) {
 /*
 =for apidoc Am|OP *|newBINOP|I32 type|I32 flags|OP *first|OP *last
 
-Constructs, checks, and returns an op of any binary type.  I<type>
-is the opcode.  I<flags> gives the eight bits of C<op_flags>, except
+Constructs, checks, and returns an op of any binary type.  C<type>
+is the opcode.  C<flags> gives the eight bits of C<op_flags>, except
 that C<OPf_KIDS> will be set automatically, and, shifted up eight bits,
 the eight bits of C<op_private>, except that the bit with value 1 or
-2 is automatically set as required.  I<first> and I<last> supply up to
+2 is automatically set as required.  C<first> and C<last> supply up to
 two ops to be the direct children of the binary op; they are consumed
 by this function and become part of the constructed op tree.
 
@@ -4957,7 +4951,7 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     if (!first)
 	first = newOP(OP_NULL, 0);
 
-    CHANGE_TYPE(binop, type);
+    OpTYPE_set(binop, type);
     binop->op_first = first;
     binop->op_flags = (U8)(flags | OPf_KIDS);
     if (!last) {
@@ -4966,20 +4960,15 @@ Perl_newBINOP(pTHX_ I32 type, I32 flags, OP *first, OP *last)
     }
     else {
 	binop->op_private = (U8)(2 | (flags >> 8));
-        OpSIBLING_set(first, last);
-        first->op_lastsib = 0;
+        OpMORESIB_set(first, last);
     }
 
-#ifdef PERL_OP_PARENT
     if (!OpHAS_SIBLING(last)) /* true unless weird syntax error */
-        last->op_sibling = (OP*)binop;
-#endif
+        OpLASTSIB_set(last, (OP*)binop);
 
     binop->op_last = OpSIBLING(binop->op_first);
-#ifdef PERL_OP_PARENT
     if (binop->op_last)
-        binop->op_last->op_sibling = (OP*)binop;
-#endif
+        OpLASTSIB_set(binop->op_last, (OP*)binop);
 
     binop = (BINOP*)CHECKOP(type, binop);
     if (binop->op_next || binop->op_type != (OPCODE)type)
@@ -5172,7 +5161,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 		}
 	    }
 
-	    /* now see which range will peter our first, if either. */
+	    /* now see which range will peter out first, if either. */
 	    tdiff = tlast - tfirst;
 	    rdiff = rlast - rfirst;
 	    tcount += tdiff + 1;
@@ -5343,7 +5332,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 =for apidoc Am|OP *|newPMOP|I32 type|I32 flags
 
 Constructs, checks, and returns an op of any pattern matching type.
-I<type> is the opcode.  I<flags> gives the eight bits of C<op_flags>
+C<type> is the opcode.  C<flags> gives the eight bits of C<op_flags>
 and, shifted up eight bits, the eight bits of C<op_private>.
 
 =cut
@@ -5359,7 +5348,7 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
 	|| type == OP_CUSTOM);
 
     NewOp(1101, pmop, 1, PMOP);
-    CHANGE_TYPE(pmop, type);
+    OpTYPE_set(pmop, type);
     pmop->op_flags = (U8)flags;
     pmop->op_private = (U8)(0 | (flags >> 8));
     if (PL_opargs[type] & OA_RETSCALAR)
@@ -5784,8 +5773,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, OP *repl, bool isreg, I32 floor)
 =for apidoc Am|OP *|newSVOP|I32 type|I32 flags|SV *sv
 
 Constructs, checks, and returns an op of any type that involves an
-embedded SV.  I<type> is the opcode.  I<flags> gives the eight bits
-of C<op_flags>.  I<sv> gives the SV to embed in the op; this function
+embedded SV.  C<type> is the opcode.  C<flags> gives the eight bits
+of C<op_flags>.  C<sv> gives the SV to embed in the op; this function
 takes ownership of one reference to it.
 
 =cut
@@ -5805,7 +5794,7 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 	|| type == OP_CUSTOM);
 
     NewOp(1101, svop, 1, SVOP);
-    CHANGE_TYPE(svop, type);
+    OpTYPE_set(svop, type);
     svop->op_sv = sv;
     svop->op_next = (OP*)svop;
     svop->op_flags = (U8)flags;
@@ -5847,9 +5836,9 @@ Perl_newDEFSVOP(pTHX)
 =for apidoc Am|OP *|newPADOP|I32 type|I32 flags|SV *sv
 
 Constructs, checks, and returns an op of any type that involves a
-reference to a pad element.  I<type> is the opcode.  I<flags> gives the
+reference to a pad element.  C<type> is the opcode.  C<flags> gives the
 eight bits of C<op_flags>.  A pad slot is automatically allocated, and
-is populated with I<sv>; this function takes ownership of one reference
+is populated with C<sv>; this function takes ownership of one reference
 to it.
 
 This function only exists if Perl has been compiled to use ithreads.
@@ -5871,7 +5860,7 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
 	|| type == OP_CUSTOM);
 
     NewOp(1101, padop, 1, PADOP);
-    CHANGE_TYPE(padop, type);
+    OpTYPE_set(padop, type);
     padop->op_padix =
 	pad_alloc(type, isGV(sv) ? SVf_READONLY : SVs_PADTMP);
     SvREFCNT_dec(PAD_SVl(padop->op_padix));
@@ -5892,8 +5881,8 @@ Perl_newPADOP(pTHX_ I32 type, I32 flags, SV *sv)
 =for apidoc Am|OP *|newGVOP|I32 type|I32 flags|GV *gv
 
 Constructs, checks, and returns an op of any type that involves an
-embedded reference to a GV.  I<type> is the opcode.  I<flags> gives the
-eight bits of C<op_flags>.  I<gv> identifies the GV that the op should
+embedded reference to a GV.  C<type> is the opcode.  C<flags> gives the
+eight bits of C<op_flags>.  C<gv> identifies the GV that the op should
 reference; calling this function does not transfer ownership of any
 reference to it.
 
@@ -5916,8 +5905,8 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 =for apidoc Am|OP *|newPVOP|I32 type|I32 flags|char *pv
 
 Constructs, checks, and returns an op of any type that involves an
-embedded C-level pointer (PV).  I<type> is the opcode.  I<flags> gives
-the eight bits of C<op_flags>.  I<pv> supplies the C-level pointer, which
+embedded C-level pointer (PV).  C<type> is the opcode.  C<flags> gives
+the eight bits of C<op_flags>.  C<pv> supplies the C-level pointer, which
 must have been allocated using C<PerlMemShared_malloc>; the memory will
 be freed when the op is destroyed.
 
@@ -5938,7 +5927,7 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
 	|| (PL_opargs[type] & OA_CLASS_MASK) == OA_LOOPEXOP);
 
     NewOp(1101, pvop, 1, PVOP);
-    CHANGE_TYPE(pvop, type);
+    OpTYPE_set(pvop, type);
     pvop->op_pv = pv;
     pvop->op_next = (OP*)pvop;
     pvop->op_flags = (U8)flags;
@@ -6116,15 +6105,15 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 Loads the module whose name is pointed to by the string part of name.
 Note that the actual module name, not its filename, should be given.
 Eg, "Foo::Bar" instead of "Foo/Bar.pm".  flags can be any of
-PERL_LOADMOD_DENY, PERL_LOADMOD_NOIMPORT, or PERL_LOADMOD_IMPORT_OPS
+C<PERL_LOADMOD_DENY>, C<PERL_LOADMOD_NOIMPORT>, or C<PERL_LOADMOD_IMPORT_OPS>
 (or 0 for no flags).  ver, if specified
 and not NULL, provides version semantics
 similar to C<use Foo::Bar VERSION>.  The optional trailing SV*
-arguments can be used to specify arguments to the module's import()
+arguments can be used to specify arguments to the module's C<import()>
 method, similar to C<use Foo::Bar VERSION LIST>.  They must be
-terminated with a final NULL pointer.  Note that this list can only
-be omitted when the PERL_LOADMOD_NOIMPORT flag has been used.
-Otherwise at least a single NULL pointer to designate the default
+terminated with a final C<NULL> pointer.  Note that this list can only
+be omitted when the C<PERL_LOADMOD_NOIMPORT> flag has been used.
+Otherwise at least a single C<NULL> pointer to designate the default
 import list is required.
 
 The reference count for each specified C<SV*> parameter is decremented.
@@ -6232,11 +6221,11 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
 
 =for apidoc Am|OP *|newSLICEOP|I32 flags|OP *subscript|OP *listval
 
-Constructs, checks, and returns an C<lslice> (list slice) op.  I<flags>
+Constructs, checks, and returns an C<lslice> (list slice) op.  C<flags>
 gives the eight bits of C<op_flags>, except that C<OPf_KIDS> will
 be set automatically, and, shifted up eight bits, the eight bits of
 C<op_private>, except that the bit with value 1 or 2 is automatically
-set as required.  I<listval> and I<subscript> supply the parameters of
+set as required.  C<listval> and C<subscript> supply the parameters of
 the slice; they are consumed by this function and become part of the
 constructed op tree.
 
@@ -6314,149 +6303,23 @@ 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
 
-Constructs, checks, and returns an assignment op.  I<left> and I<right>
+Constructs, checks, and returns an assignment op.  C<left> and C<right>
 supply the parameters of the assignment; they are consumed by this
 function and become part of the constructed op tree.
 
-If I<optype> is C<OP_ANDASSIGN>, C<OP_ORASSIGN>, or C<OP_DORASSIGN>, then
-a suitable conditional optree is constructed.  If I<optype> is the opcode
+If C<optype> is C<OP_ANDASSIGN>, C<OP_ORASSIGN>, or C<OP_DORASSIGN>, then
+a suitable conditional optree is constructed.  If C<optype> is the opcode
 of a binary operator, such as C<OP_BIT_OR>, then an op is constructed that
 performs the binary operation and assigns the result to the left argument.
-Either way, if I<optype> is non-zero then I<flags> has no effect.
+Either way, if C<optype> is non-zero then C<flags> has no effect.
 
-If I<optype> is zero, then a plain scalar or list assignment is
+If C<optype> is zero, then a plain scalar or list assignment is
 constructed.  Which type of assignment it is is automatically determined.
-I<flags> gives the eight bits of C<op_flags>, except that C<OPf_KIDS>
+C<flags> gives the eight bits of C<op_flags>, except that C<OPf_KIDS>
 will be set automatically, and, shifted up eight bits, the eight bits
 of C<op_private>, except that the bit with value 1 or 2 is automatically
 set as required.
@@ -6486,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;
@@ -6500,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) = ...
@@ -6552,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
@@ -6671,13 +6503,13 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 Constructs a state op (COP).  The state op is normally a C<nextstate> op,
 but will be a C<dbstate> op if debugging is enabled for currently-compiled
 code.  The state op is populated from C<PL_curcop> (or C<PL_compiling>).
-If I<label> is non-null, it supplies the name of a label to attach to
+If C<label> is non-null, it supplies the name of a label to attach to
 the state op; this function takes ownership of the memory pointed at by
-I<label>, and will free it.  I<flags> gives the eight bits of C<op_flags>
+C<label>, and will free it.  C<flags> gives the eight bits of C<op_flags>
 for the state op.
 
-If I<o> is null, the state op is returned.  Otherwise the state op is
-combined with I<o> into a C<lineseq> list op, which is returned.  I<o>
+If C<o> is null, the state op is returned.  Otherwise the state op is
+combined with C<o> into a C<lineseq> list op, which is returned.  C<o>
 is consumed by this function and becomes part of the returned op tree.
 
 =cut
@@ -6697,10 +6529,10 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 
     NewOp(1101, cop, 1, COP);
     if (PERLDB_LINE && CopLINE(PL_curcop) && PL_curstash != PL_debstash) {
-        CHANGE_TYPE(cop, OP_DBSTATE);
+        OpTYPE_set(cop, OP_DBSTATE);
     }
     else {
-        CHANGE_TYPE(cop, OP_NEXTSTATE);
+        OpTYPE_set(cop, OP_NEXTSTATE);
     }
     cop->op_flags = (U8)flags;
     CopHINTS_set(cop, PL_hints);
@@ -6759,12 +6591,12 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 /*
 =for apidoc Am|OP *|newLOGOP|I32 type|I32 flags|OP *first|OP *other
 
-Constructs, checks, and returns a logical (flow control) op.  I<type>
-is the opcode.  I<flags> gives the eight bits of C<op_flags>, except
+Constructs, checks, and returns a logical (flow control) op.  C<type>
+is the opcode.  C<flags> gives the eight bits of C<op_flags>, except
 that C<OPf_KIDS> will be set automatically, and, shifted up eight bits,
 the eight bits of C<op_private>, except that the bit with value 1 is
-automatically set.  I<first> supplies the expression controlling the
-flow, and I<other> supplies the side (alternate) chain of ops; they are
+automatically set.  C<first> supplies the expression controlling the
+flow, and C<other> supplies the side (alternate) chain of ops; they are
 consumed by this function and become part of the constructed op tree.
 
 =cut
@@ -7023,11 +6855,11 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 =for apidoc Am|OP *|newCONDOP|I32 flags|OP *first|OP *trueop|OP *falseop
 
 Constructs, checks, and returns a conditional-expression (C<cond_expr>)
-op.  I<flags> gives the eight bits of C<op_flags>, except that C<OPf_KIDS>
+op.  C<flags> gives the eight bits of C<op_flags>, except that C<OPf_KIDS>
 will be set automatically, and, shifted up eight bits, the eight bits of
 C<op_private>, except that the bit with value 1 is automatically set.
-I<first> supplies the expression selecting between the two branches,
-and I<trueop> and I<falseop> supply the branches; they are consumed by
+C<first> supplies the expression selecting between the two branches,
+and C<trueop> and C<falseop> supply the branches; they are consumed by
 this function and become part of the constructed op tree.
 
 =cut
@@ -7098,10 +6930,10 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 =for apidoc Am|OP *|newRANGE|I32 flags|OP *left|OP *right
 
 Constructs and returns a C<range> op, with subordinate C<flip> and
-C<flop> ops.  I<flags> gives the eight bits of C<op_flags> for the
+C<flop> ops.  C<flags> gives the eight bits of C<op_flags> for the
 C<flip> op and, shifted up eight bits, the eight bits of C<op_private>
 for both the C<flip> and C<range> ops, except that the bit with value
-1 is automatically set.  I<left> and I<right> supply the expressions
+1 is automatically set.  C<left> and C<right> supply the expressions
 controlling the endpoints of the range; they are consumed by this function
 and become part of the constructed op tree.
 
@@ -7167,11 +6999,11 @@ Perl_newRANGE(pTHX_ I32 flags, OP *left, OP *right)
 Constructs, checks, and returns an op tree expressing a loop.  This is
 only a loop in the control flow through the op tree; it does not have
 the heavyweight loop structure that allows exiting the loop by C<last>
-and suchlike.  I<flags> gives the eight bits of C<op_flags> for the
+and suchlike.  C<flags> gives the eight bits of C<op_flags> for the
 top-level op, except that some bits will be set automatically as required.
-I<expr> supplies the expression controlling loop iteration, and I<block>
+C<expr> supplies the expression controlling loop iteration, and C<block>
 supplies the body of the loop; they are consumed by this function and
-become part of the constructed op tree.  I<debuggable> is currently
+become part of the constructed op tree.  C<debuggable> is currently
 unused and should always be 1.
 
 =cut
@@ -7265,18 +7097,18 @@ Constructs, checks, and returns an op tree expressing a C<while> loop.
 This is a heavyweight loop, with structure that allows exiting the loop
 by C<last> and suchlike.
 
-I<loop> is an optional preconstructed C<enterloop> op to use in the
+C<loop> is an optional preconstructed C<enterloop> op to use in the
 loop; if it is null then a suitable op will be constructed automatically.
-I<expr> supplies the loop's controlling expression.  I<block> supplies the
-main body of the loop, and I<cont> optionally supplies a C<continue> block
+C<expr> supplies the loop's controlling expression.  C<block> supplies the
+main body of the loop, and C<cont> optionally supplies a C<continue> block
 that operates as a second half of the body.  All of these optree inputs
 are consumed by this function and become part of the constructed op tree.
 
-I<flags> gives the eight bits of C<op_flags> for the C<leaveloop>
+C<flags> gives the eight bits of C<op_flags> for the C<leaveloop>
 op and, shifted up eight bits, the eight bits of C<op_private> for
 the C<leaveloop> op, except that (in both cases) some bits will be set
-automatically.  I<debuggable> is currently unused and should always be 1.
-I<has_my> can be supplied as true to force the
+automatically.  C<debuggable> is currently unused and should always be 1.
+C<has_my> can be supplied as true to force the
 loop body to be enclosed in its own scope.
 
 =cut
@@ -7363,7 +7195,7 @@ Perl_newWHILEOP(pTHX_ I32 flags, I32 debuggable, LOOP *loop,
 
     if (!loop) {
 	NewOp(1101,loop,1,LOOP);
-        CHANGE_TYPE(loop, OP_ENTERLOOP);
+        OpTYPE_set(loop, OP_ENTERLOOP);
 	loop->op_private = 0;
 	loop->op_next = (OP*)loop;
     }
@@ -7391,15 +7223,15 @@ Constructs, checks, and returns an op tree expressing a C<foreach>
 loop (iteration through a list of values).  This is a heavyweight loop,
 with structure that allows exiting the loop by C<last> and suchlike.
 
-I<sv> optionally supplies the variable that will be aliased to each
+C<sv> optionally supplies the variable that will be aliased to each
 item in turn; if null, it defaults to C<$_> (either lexical or global).
-I<expr> supplies the list of values to iterate over.  I<block> supplies
-the main body of the loop, and I<cont> optionally supplies a C<continue>
+C<expr> supplies the list of values to iterate over.  C<block> supplies
+the main body of the loop, and C<cont> optionally supplies a C<continue>
 block that operates as a second half of the body.  All of these optree
 inputs are consumed by this function and become part of the constructed
 op tree.
 
-I<flags> gives the eight bits of C<op_flags> for the C<leaveloop>
+C<flags> gives the eight bits of C<op_flags> for the C<leaveloop>
 op and, shifted up eight bits, the eight bits of C<op_private> for
 the C<leaveloop> op, except that (in both cases) some bits will be set
 automatically.
@@ -7422,7 +7254,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     if (sv) {
 	if (sv->op_type == OP_RV2SV) {	/* symbol table variable */
 	    iterpflags = sv->op_private & OPpOUR_INTRO; /* for our $x () */
-            CHANGE_TYPE(sv, OP_RV2GV);
+            OpTYPE_set(sv, OP_RV2GV);
 
 	    /* The op_type check is needed to prevent a possible segfault
 	     * if the loop variable is undeclared and 'strict vars' is in
@@ -7502,8 +7334,9 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
         expr = op_lvalue(force_list(expr, 1), OP_GREPSTART);
     }
 
-    loop = (LOOP*)list(op_convert_list(OP_ENTERITER, iterflags,
-			       op_append_elem(OP_LIST, expr, scalar(sv))));
+    loop = (LOOP*)op_convert_list(OP_ENTERITER, iterflags,
+                                  op_append_elem(OP_LIST, list(expr),
+                                                 scalar(sv)));
     assert(!loop->op_next);
     /* for my  $x () sets OPpLVAL_INTRO;
      * for our $x () sets OPpOUR_INTRO */
@@ -7516,8 +7349,8 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
 	NewOp(1234,tmp,1,LOOP);
 	Copy(loop,tmp,1,LISTOP);
 #ifdef PERL_OP_PARENT
-        assert(loop->op_last->op_sibling == (OP*)loop);
-        loop->op_last->op_sibling = (OP*)tmp; /*point back to new parent */
+        assert(loop->op_last->op_sibparent == (OP*)loop);
+        OpLASTSIB_set(loop->op_last, (OP*)tmp); /*point back to new parent */
 #endif
 	S_op_destroy(aTHX_ (OP*)loop);
 	loop = tmp;
@@ -7526,7 +7359,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     {
 	loop = (LOOP*)PerlMemShared_realloc(loop, sizeof(LOOP));
 #ifdef PERL_OP_PARENT
-	loop->op_last->op_sibling = (OP *)loop;
+        OpLASTSIB_set(loop->op_last, (OP*)loop);
 #endif
     }
     loop->op_targ = padoff;
@@ -7538,7 +7371,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
 =for apidoc Am|OP *|newLOOPEX|I32 type|OP *label
 
 Constructs, checks, and returns a loop-exiting op (such as C<goto>
-or C<last>).  I<type> is the opcode.  I<label> supplies the parameter
+or C<last>).  C<type> is the opcode.  C<label> supplies the parameter
 determining the target of the op; it is consumed by this function and
 becomes part of the constructed op tree.
 
@@ -7612,7 +7445,7 @@ S_ref_array_or_hash(pTHX_ OP *cond)
 
 	/* anonlist now needs a list from this op, was previously used in
 	 * scalar context */
-	cond->op_flags |= ~(OPf_WANT_SCALAR | OPf_REF);
+	cond->op_flags &= ~(OPf_WANT_SCALAR | OPf_REF);
 	cond->op_flags |= OPf_WANT_LIST;
 
 	return newANONLIST(op_lvalue(cond, OP_ANONLIST));
@@ -7760,11 +7593,11 @@ S_looks_like_bool(pTHX_ const OP *o)
 =for apidoc Am|OP *|newGIVENOP|OP *cond|OP *block|PADOFFSET defsv_off
 
 Constructs, checks, and returns an op tree expressing a C<given> block.
-I<cond> supplies the expression that will be locally assigned to a lexical
-variable, and I<block> supplies the body of the C<given> construct; they
+C<cond> supplies the expression that will be locally assigned to a lexical
+variable, and C<block> supplies the body of the C<given> construct; they
 are consumed by this function and become part of the constructed op tree.
-I<defsv_off> is the pad offset of the scalar lexical variable that will
-be affected.  If it is 0, the global $_ will be used.
+C<defsv_off> is the pad offset of the scalar lexical variable that will
+be affected.  If it is 0, the global C<$_> will be used.
 
 =cut
 */
@@ -7784,9 +7617,9 @@ Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
 =for apidoc Am|OP *|newWHENOP|OP *cond|OP *block
 
 Constructs, checks, and returns an op tree expressing a C<when> block.
-I<cond> supplies the test expression, and I<block> supplies the block
+C<cond> supplies the test expression, and C<block> supplies the block
 that will be executed if the test evaluates to true; they are consumed
-by this function and become part of the constructed op tree.  I<cond>
+by this function and become part of the constructed op tree.  C<cond>
 will be interpreted DWIMically, often as a comparison against C<$_>,
 and may be null to generate a C<default> block.
 
@@ -7900,7 +7733,7 @@ static void const_av_xsub(pTHX_ CV* cv);
 =for apidoc cv_const_sv
 
 If C<cv> is a constant sub eligible for inlining, returns the constant
-value returned by the sub.  Otherwise, returns NULL.
+value returned by the sub.  Otherwise, returns C<NULL>.
 
 Constant subs can be created with C<newCONSTSUB> or as described in
 L<perlsub/"Constant Functions">.
@@ -8150,14 +7983,13 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		   : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
 	start = LINKLIST(block);
 	block->op_next = 0;
+        if (ps && !*ps && !attrs && !CvLVALUE(compcv))
+            const_sv = S_op_const_sv(aTHX_ start, compcv, FALSE);
+        else
+            const_sv = NULL;
     }
-
-    if (!block || !ps || *ps || attrs
-	|| CvLVALUE(compcv)
-	)
-	const_sv = NULL;
     else
-	const_sv = S_op_const_sv(aTHX_ start, compcv, FALSE);
+        const_sv = NULL;
 
     if (cv) {
         const bool exists = CvROOT(cv) || CvXSUB(cv);
@@ -8388,7 +8220,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (slab)
 	Slab_to_ro(slab);
 #endif
-    if (o) op_free(o);
+    op_free(o);
     return cv;
 }
 
@@ -8458,9 +8290,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
 	has_name = FALSE;
     }
-    if (!ec)
-	move_proto_attr(&proto, &attrs,
-			isGV(gv) ? gv : (GV *)cSVOPo->op_sv);
+    if (!ec) {
+        if (isGV(gv)) {
+            move_proto_attr(&proto, &attrs, gv);
+        } else {
+            assert(cSVOPo);
+            move_proto_attr(&proto, &attrs, (GV *)cSVOPo->op_sv);
+        }
+    }
 
     if (proto) {
 	assert(proto->op_type == OP_CONST);
@@ -8555,15 +8392,14 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 		   : newUNOP(OP_LEAVESUB, 0, scalarseq(block));
 	start = LINKLIST(block);
 	block->op_next = 0;
+        if (ps && !*ps && !attrs && !CvLVALUE(PL_compcv))
+            const_sv =
+                S_op_const_sv(aTHX_ start, PL_compcv, CvCLONE(PL_compcv));
+        else
+            const_sv = NULL;
     }
-
-    if (!block || !ps || *ps || attrs
-	|| CvLVALUE(PL_compcv)
-	)
-	const_sv = NULL;
     else
-	const_sv =
-	    S_op_const_sv(aTHX_ start, PL_compcv, cBOOL(CvCLONE(PL_compcv)));
+        const_sv = NULL;
 
     if (SvPOK(gv) || (SvROK(gv) && SvTYPE(SvRV(gv)) != SVt_PVCV)) {
 	assert (block);
@@ -8964,15 +8800,15 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 /*
 =for apidoc newCONSTSUB_flags
 
-Creates a constant sub equivalent to Perl C<sub FOO () { 123 }> which is
+Creates a constant sub equivalent to Perl S<C<sub FOO () { 123 }>> which is
 eligible for inlining at compile-time.
 
-Currently, the only useful value for C<flags> is SVf_UTF8.
+Currently, the only useful value for C<flags> is C<SVf_UTF8>.
 
 The newly created subroutine takes ownership of a reference to the passed in
 SV.
 
-Passing NULL for SV creates a constant sub equivalent to C<sub BAR () {}>,
+Passing C<NULL> for SV creates a constant sub equivalent to S<C<sub BAR () {}>>,
 which won't be called if used as a destructor, but will suppress the overhead
 of a call to C<AUTOLOAD>.  (This form, however, isn't eligible for inlining at
 compile time.)
@@ -9033,7 +8869,7 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len,
 /*
 =for apidoc U||newXS
 
-Used by C<xsubpp> to hook up XSUBs as Perl subs.  I<filename> needs to be
+Used by C<xsubpp> to hook up XSUBs as Perl subs.  C<filename> needs to be
 static storage, as it is used directly as CvFILE(), without a copy being made.
 
 =cut
@@ -9064,7 +8900,7 @@ Perl_newXS_deffile(pTHX_ const char *name, XSUBADDR_t subaddr)
 {
     PERL_ARGS_ASSERT_NEWXS_DEFFILE;
     return newXS_len_flags(
-	name, name ? strlen(name) : 0, subaddr, NULL, NULL, NULL, 0
+        name, strlen(name), subaddr, NULL, NULL, NULL, 0
     );
 }
 
@@ -9078,9 +8914,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
     bool interleave = FALSE;
 
     PERL_ARGS_ASSERT_NEWXS_LEN_FLAGS;
-    if (!subaddr)
-	Perl_croak_nocontext("panic: no address for '%s' in '%s'",
-	    name, filename ? filename : PL_xsubfilename);
+
     {
         GV * const gv = gv_fetchpvn(
 			    name ? name : PL_curstash ? "__ANON__" : "__ANON__::__ANON__",
@@ -9125,7 +8959,9 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
 
         CvGV_set(cv, gv);
         if(filename) {
-            (void)gv_fetchfile(filename);
+            /* XSUBs can't be perl lang/perl5db.pl debugged
+            if (PERLDB_LINE_OR_SAVESRC)
+                (void)gv_fetchfile(filename); */
             assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */
             if (flags & XS_DYNAMIC_FILENAME) {
                 CvDYNFILE_on(cv);
@@ -9283,12 +9119,12 @@ Perl_oopsAV(pTHX_ OP *o)
     switch (o->op_type) {
     case OP_PADSV:
     case OP_PADHV:
-        CHANGE_TYPE(o, OP_PADAV);
+        OpTYPE_set(o, OP_PADAV);
 	return ref(o, OP_RV2AV);
 
     case OP_RV2SV:
     case OP_RV2HV:
-        CHANGE_TYPE(o, OP_RV2AV);
+        OpTYPE_set(o, OP_RV2AV);
 	ref(o, OP_RV2AV);
 	break;
 
@@ -9309,12 +9145,12 @@ Perl_oopsHV(pTHX_ OP *o)
     switch (o->op_type) {
     case OP_PADSV:
     case OP_PADAV:
-        CHANGE_TYPE(o, OP_PADHV);
+        OpTYPE_set(o, OP_PADHV);
 	return ref(o, OP_RV2HV);
 
     case OP_RV2SV:
     case OP_RV2AV:
-        CHANGE_TYPE(o, OP_RV2HV);
+        OpTYPE_set(o, OP_RV2HV);
 	ref(o, OP_RV2HV);
 	break;
 
@@ -9333,7 +9169,7 @@ Perl_newAVREF(pTHX_ OP *o)
     PERL_ARGS_ASSERT_NEWAVREF;
 
     if (o->op_type == OP_PADANY) {
-        CHANGE_TYPE(o, OP_PADAV);
+        OpTYPE_set(o, OP_PADAV);
 	return o;
     }
     else if ((o->op_type == OP_RV2AV || o->op_type == OP_PADAV)) {
@@ -9358,7 +9194,7 @@ Perl_newHVREF(pTHX_ OP *o)
     PERL_ARGS_ASSERT_NEWHVREF;
 
     if (o->op_type == OP_PADANY) {
-        CHANGE_TYPE(o, OP_PADHV);
+        OpTYPE_set(o, OP_PADHV);
 	return o;
     }
     else if ((o->op_type == OP_RV2HV || o->op_type == OP_PADHV)) {
@@ -9372,7 +9208,7 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
 {
     if (o->op_type == OP_PADANY) {
 	dVAR;
-        CHANGE_TYPE(o, OP_PADCV);
+        OpTYPE_set(o, OP_PADCV);
     }
     return newUNOP(OP_RV2CV, flags, scalar(o));
 }
@@ -9385,7 +9221,7 @@ Perl_newSVREF(pTHX_ OP *o)
     PERL_ARGS_ASSERT_NEWSVREF;
 
     if (o->op_type == OP_PADANY) {
-        CHANGE_TYPE(o, OP_PADSV);
+        OpTYPE_set(o, OP_PADSV);
         scalar(o);
 	return o;
     }
@@ -9682,7 +9518,7 @@ Perl_ck_eval(pTHX_ OP *o)
 	    enter->op_next = (OP*)enter;
 
 	    o = op_prepend_elem(OP_LINESEQ, (OP*)enter, (OP*)kid);
-            CHANGE_TYPE(o, OP_LEAVETRY);
+            OpTYPE_set(o, OP_LEAVETRY);
 	    enter->op_other = o;
 	    return o;
 	}
@@ -9833,7 +9669,7 @@ Perl_ck_rvconst(pTHX_ OP *o)
 		  && SvTYPE(SvRV(gv)) != SVt_PVCV)
 		    gv_fetchsv(kidsv, GV_ADDMULTI, SVt_PVCV);
 	    }
-            CHANGE_TYPE(kid, OP_GV);
+            OpTYPE_set(kid, OP_GV);
 	    SvREFCNT_dec(kid->op_sv);
 #ifdef USE_ITHREADS
 	    /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
@@ -9979,17 +9815,13 @@ Perl_ck_fun(pTHX_ OP *o)
 		         || SvTYPE(SvRV(cSVOPx_sv(kid))) != SVt_PVAV  )
 		        )
 		    bad_type_pv(numargs, "array", o, kid);
-		/* Defer checks to run-time if we have a scalar arg */
-		if (kid->op_type == OP_RV2AV || kid->op_type == OP_PADAV)
-		    op_lvalue(kid, type);
-		else {
-		    scalar(kid);
-		    /* diag_listed_as: push on reference is experimental */
-		    Perl_ck_warner_d(aTHX_
-				     packWARN(WARN_EXPERIMENTAL__AUTODEREF),
-				    "%s on reference is experimental",
-				     PL_op_desc[type]);
+		else if (kid->op_type != OP_RV2AV && kid->op_type != OP_PADAV) {
+                    yyerror_pv(Perl_form(aTHX_ "Experimental %s on scalar is now forbidden",
+                                         PL_op_desc[type]), 0);
 		}
+                else {
+                    op_lvalue(kid, type);
+                }
 		break;
 	    case OA_HVREF:
 		if (kid->op_type != OP_RV2HV && kid->op_type != OP_PADHV)
@@ -10332,7 +10164,7 @@ Perl_ck_readline(pTHX_ OP *o)
     }
     else {
 	OP * const newop
-	    = newUNOP(OP_READLINE, o->op_flags | OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
+	    = newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, PL_argvgv));
 	op_free(o);
 	return newop;
     }
@@ -10407,10 +10239,10 @@ Perl_ck_smartmatch(pTHX_ OP *o)
 	
 	/* Implicitly take a reference to a regular expression */
 	if (first->op_type == OP_MATCH) {
-            CHANGE_TYPE(first, OP_QR);
+            OpTYPE_set(first, OP_QR);
 	}
 	if (second->op_type == OP_MATCH) {
-            CHANGE_TYPE(second, OP_QR);
+            OpTYPE_set(second, OP_QR);
         }
     }
     
@@ -10474,10 +10306,13 @@ Perl_ck_sassign(pTHX_ OP *o)
 				    | ((kkid->op_private & ~OPpLVAL_INTRO) << 8));
 	    OP *const first = newOP(OP_NULL, 0);
 	    OP *const nullop =
+		newCONDOP(0, first, o, other);
+	    /* XXX targlex disabled for now; see ticket #124160
 		newCONDOP(0, first, S_maybe_targlex(aTHX_ o), other);
+	     */
 	    OP *const condop = first->op_next;
 
-            CHANGE_TYPE(condop, OP_ONCE);
+            OpTYPE_set(condop, OP_ONCE);
 	    other->op_targ = target;
 	    nullop->op_flags |= OPf_WANT_SCALAR;
 
@@ -10631,7 +10466,11 @@ Perl_ck_refassign(pTHX_ OP *o)
     assert (left);
     assert (left->op_type == OP_SREFGEN);
 
-    o->op_private = varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE);
+    o->op_private = 0;
+    /* we use OPpPAD_STATE in refassign to mean either of those things,
+     * and the code assumes the two flags occupy the same bit position
+     * in the various ops below */
+    assert(OPpPAD_STATE == OPpOUR_INTRO);
 
     switch (varop->op_type) {
     case OP_PADAV:
@@ -10639,19 +10478,25 @@ Perl_ck_refassign(pTHX_ OP *o)
 	goto settarg;
     case OP_PADHV:
 	o->op_private |= OPpLVREF_HV;
+        /* FALLTHROUGH */
     case OP_PADSV:
       settarg:
+        o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpPAD_STATE));
 	o->op_targ = varop->op_targ;
 	varop->op_targ = 0;
 	PAD_COMPNAME_GEN_set(o->op_targ, PERL_INT_MAX);
 	break;
+
     case OP_RV2AV:
 	o->op_private |= OPpLVREF_AV;
 	goto checkgv;
+        NOT_REACHED; /* NOTREACHED */
     case OP_RV2HV:
 	o->op_private |= OPpLVREF_HV;
+        /* FALLTHROUGH */
     case OP_RV2SV:
       checkgv:
+        o->op_private |= (varop->op_private & (OPpLVAL_INTRO|OPpOUR_INTRO));
 	if (cUNOPx(varop)->op_first->op_type != OP_GV) goto bad;
       detach_and_stack:
 	/* Point varop to its GV kid, detached.  */
@@ -10660,7 +10505,7 @@ Perl_ck_refassign(pTHX_ OP *o)
 	break;
     case OP_RV2CV: {
 	OP * const kidparent =
-	    cUNOPx(cUNOPx(varop)->op_first)->op_first->op_sibling;
+	    OpSIBLING(cUNOPx(cUNOPx(varop)->op_first)->op_first);
 	OP * const kid = cUNOPx(kidparent)->op_first;
 	o->op_private |= OPpLVREF_CV;
 	if (kid->op_type == OP_GV) {
@@ -10674,6 +10519,7 @@ Perl_ck_refassign(pTHX_ OP *o)
     }
     case OP_AELEM:
     case OP_HELEM:
+        o->op_private |= (varop->op_private & OPpLVAL_INTRO);
 	o->op_private |= OPpLVREF_ELEM;
 	op_null(varop);
 	stacked = TRUE;
@@ -10768,7 +10614,8 @@ Perl_ck_require(pTHX_ OP *o)
 	    unshare_hek(hek);
 	    SvFLAGS(sv) |= was_readonly;
 	  }
-	  else if (SvPOK(sv) && !SvNIOK(sv) && !SvGMAGICAL(sv)) {
+	  else if (SvPOK(sv) && !SvNIOK(sv) && !SvGMAGICAL(sv)
+		&& !SvVOK(sv)) {
 	    s = SvPV(sv, len);
 	    if (SvREFCNT(sv) > 1) {
 		kid->op_sv = newSVpvn_share(
@@ -10836,7 +10683,7 @@ Perl_ck_select(pTHX_ OP *o)
     if (o->op_flags & OPf_KIDS) {
         kid = OpSIBLING(cLISTOPo->op_first);     /* get past pushmark */
         if (kid && OpHAS_SIBLING(kid)) {
-            CHANGE_TYPE(o, OP_SSELECT);
+            OpTYPE_set(o, OP_SSELECT);
 	    o = ck_fun(o);
 	    return fold_constants(op_integerize(op_std_init(o)));
 	}
@@ -10935,10 +10782,8 @@ Perl_ck_sort(pTHX_ OP *o)
 		else {
 		    OP * const padop = newOP(OP_PADCV, 0);
 		    padop->op_targ = off;
-		    cUNOPx(firstkid)->op_first = padop;
-#ifdef PERL_OP_PARENT
-                    padop->op_sibling = firstkid;
-#endif
+                    /* replace the const op with the pad op */
+                    op_sibling_splice(firstkid, NULL, 1, padop);
 		    op_free(kid);
 		}
 	    }
@@ -11096,7 +10941,9 @@ Perl_ck_split(pTHX_ OP *o)
         kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, NULL, 0, 0);
         op_sibling_splice(o, NULL, 0, kid);
     }
-    CHANGE_TYPE(kid, OP_PUSHRE);
+    OpTYPE_set(kid, OP_PUSHRE);
+    /* target implies @ary=..., so wipe it */
+    kid->op_targ = 0;
     scalar(kid);
     if (((PMOP *)kid)->op_pmflags & PMf_GLOBAL) {
       Perl_ck_warner(aTHX_ packWARN(WARN_REGEXP),
@@ -11131,11 +10978,11 @@ Perl_ck_stringify(pTHX_ OP *o)
 {
     OP * const kid = OpSIBLING(cUNOPo->op_first);
     PERL_ARGS_ASSERT_CK_STRINGIFY;
-    if (kid->op_type == OP_JOIN || kid->op_type == OP_QUOTEMETA
-     || kid->op_type == OP_LC   || kid->op_type == OP_LCFIRST
-     || kid->op_type == OP_UC   || kid->op_type == OP_UCFIRST)
+    if ((   kid->op_type == OP_JOIN || kid->op_type == OP_QUOTEMETA
+         || kid->op_type == OP_LC   || kid->op_type == OP_LCFIRST
+         || kid->op_type == OP_UC   || kid->op_type == OP_UCFIRST)
+	&& !OpHAS_SIBLING(kid)) /* syntax errs can leave extra children */
     {
-	assert(!OpHAS_SIBLING(kid));
 	op_sibling_splice(o, cUNOPo->op_first, -1, NULL);
 	op_free(o);
 	return kid;
@@ -11188,7 +11035,7 @@ Perl_ck_join(pTHX_ OP *o)
 Examines an op, which is expected to identify a subroutine at runtime,
 and attempts to determine at compile time which subroutine it identifies.
 This is normally used during Perl compilation to determine whether
-a prototype can be applied to a function call.  I<cvop> is the op
+a prototype can be applied to a function call.  C<cvop> is the op
 being considered, normally an C<rv2cv> op.  A pointer to the identified
 subroutine is returned, if it could be determined statically, and a null
 pointer is returned if it was not possible to determine statically.
@@ -11202,14 +11049,14 @@ has the C<OPpENTERSUB_AMPER> flag set then no attempt is made to identify
 the subroutine statically: this flag is used to suppress compile-time
 magic on a subroutine call, forcing it to use default runtime behaviour.
 
-If I<flags> has the bit C<RV2CVOPCV_MARK_EARLY> set, then the handling
+If C<flags> has the bit C<RV2CVOPCV_MARK_EARLY> set, then the handling
 of a GV reference is modified.  If a GV was examined and its CV slot was
 found to be empty, then the C<gv> op has the C<OPpEARLY_CV> flag set.
 If the op is not optimised away, and the CV slot is later populated with
 a subroutine having a prototype, that flag eventually triggers the warning
 "called too early to check prototype".
 
-If I<flags> has the bit C<RV2CVOPCV_RETURN_NAME_GV> set, then instead
+If C<flags> has the bit C<RV2CVOPCV_RETURN_NAME_GV> set, then instead
 of returning a pointer to the subroutine it returns a pointer to the
 GV giving the most appropriate name for the subroutine in this context.
 Normally this is just the C<CvGV> of the subroutine, but for an anonymous
@@ -11229,7 +11076,7 @@ Perl_find_lexical_cv(pTHX_ PADOFFSET off)
     CV *compcv = PL_compcv;
     while (PadnameOUTER(name)) {
 	assert(PARENT_PAD_INDEX(name));
-	compcv = CvOUTSIDE(PL_compcv);
+	compcv = CvOUTSIDE(compcv);
 	name = PadlistNAMESARRAY(CvPADLIST(compcv))
 		[off = PARENT_PAD_INDEX(name)];
     }
@@ -11342,7 +11189,7 @@ the prototype.  This is the standard treatment used on a subroutine call,
 not marked with C<&>, where the callee can be identified at compile time
 and has a prototype.
 
-I<protosv> supplies the subroutine prototype to be applied to the call.
+C<protosv> supplies the subroutine prototype to be applied to the call.
 It may be a normal defined scalar, of which the string value will be used.
 Alternatively, for convenience, it may be a subroutine object (a C<CV*>
 that has been cast to C<SV*>) which has a prototype.  The prototype
@@ -11354,7 +11201,7 @@ an unacceptable number of arguments, a valid op tree is returned anyway.
 The error is reflected in the parser state, normally resulting in a single
 exception at the top level of parsing which covers all the compilation
 errors that occurred.  In the error message, the callee is referred to
-by the name defined by the I<namegv> parameter.
+by the name defined by the C<namegv> parameter.
 
 =cut
 */
@@ -11421,11 +11268,12 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    case '&':
 		proto++;
 		arg++;
-		if (o3->op_type != OP_SREFGEN
-		 || (  cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
-			!= OP_ANONCODE
-		    && cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
-			!= OP_RV2CV))
+		if (    o3->op_type != OP_UNDEF
+                    && (o3->op_type != OP_SREFGEN
+                        || (  cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
+                                != OP_ANONCODE
+                            && cUNOPx(cUNOPx(o3)->op_first)->op_first->op_type
+                                != OP_RV2CV)))
 		    bad_type_gv(arg, namegv, o3,
 			    arg == 1 ? "block or sub {}" : "sub {}");
 		break;
@@ -11586,7 +11434,7 @@ based on a subroutine prototype or using default list-context processing.
 This is the standard treatment used on a subroutine call, not marked
 with C<&>, where the callee can be identified at compile time.
 
-I<protosv> supplies the subroutine prototype to be applied to the call,
+C<protosv> supplies the subroutine prototype to be applied to the call,
 or indicates that there is no prototype.  It may be a normal scalar,
 in which case if it is defined then the string value will be used
 as a prototype, and if it is undefined then there is no prototype.
@@ -11600,7 +11448,7 @@ an unacceptable number of arguments, a valid op tree is returned anyway.
 The error is reflected in the parser state, normally resulting in a single
 exception at the top level of parsing which covers all the compilation
 errors that occurred.  In the error message, the callee is referred to
-by the name defined by the I<namegv> parameter.
+by the name defined by the C<namegv> parameter.
 
 =cut
 */
@@ -11650,7 +11498,7 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	                           )
 	                        );
 	}
-	NOT_REACHED;
+	NOT_REACHED; /* NOTREACHED */
     }
     else {
 	OP *prev, *cvop, *first, *parent;
@@ -11708,26 +11556,26 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 	    return op_convert_list(opnum,0,aop);
 	}
     }
-    NOT_REACHED;
+    NOT_REACHED; /* NOTREACHED */
     return entersubop;
 }
 
 /*
 =for apidoc Am|void|cv_get_call_checker|CV *cv|Perl_call_checker *ckfun_p|SV **ckobj_p
 
-Retrieves the function that will be used to fix up a call to I<cv>.
+Retrieves the function that will be used to fix up a call to C<cv>.
 Specifically, the function is applied to an C<entersub> op tree for a
 subroutine call, not marked with C<&>, where the callee can be identified
-at compile time as I<cv>.
+at compile time as C<cv>.
 
-The C-level function pointer is returned in I<*ckfun_p>, and an SV
-argument for it is returned in I<*ckobj_p>.  The function is intended
+The C-level function pointer is returned in C<*ckfun_p>, and an SV
+argument for it is returned in C<*ckobj_p>.  The function is intended
 to be called in this manner:
 
-    entersubop = (*ckfun_p)(aTHX_ entersubop, namegv, (*ckobj_p));
+ entersubop = (*ckfun_p)(aTHX_ entersubop, namegv, (*ckobj_p));
 
-In this call, I<entersubop> is a pointer to the C<entersub> op,
-which may be replaced by the check function, and I<namegv> is a GV
+In this call, C<entersubop> is a pointer to the C<entersub> op,
+which may be replaced by the check function, and C<namegv> is a GV
 supplying the name that should be used by the check function to refer
 to the callee of the C<entersub> op if it needs to emit any diagnostics.
 It is permitted to apply the check function in non-standard situations,
@@ -11735,7 +11583,7 @@ such as to a call to a different subroutine or to a method call.
 
 By default, the function is
 L<Perl_ck_entersub_args_proto_or_list|/ck_entersub_args_proto_or_list>,
-and the SV parameter is I<cv> itself.  This implements standard
+and the SV parameter is C<cv> itself.  This implements standard
 prototype processing.  It can be changed, for a particular subroutine,
 by L</cv_set_call_checker>.
 
@@ -11770,13 +11618,13 @@ Perl_cv_get_call_checker(pTHX_ CV *cv, Perl_call_checker *ckfun_p, SV **ckobj_p)
 /*
 =for apidoc Am|void|cv_set_call_checker_flags|CV *cv|Perl_call_checker ckfun|SV *ckobj|U32 flags
 
-Sets the function that will be used to fix up a call to I<cv>.
+Sets the function that will be used to fix up a call to C<cv>.
 Specifically, the function is applied to an C<entersub> op tree for a
 subroutine call, not marked with C<&>, where the callee can be identified
-at compile time as I<cv>.
+at compile time as C<cv>.
 
-The C-level function pointer is supplied in I<ckfun>, and an SV argument
-for it is supplied in I<ckobj>.  The function should be defined like this:
+The C-level function pointer is supplied in C<ckfun>, and an SV argument
+for it is supplied in C<ckobj>.  The function should be defined like this:
 
     STATIC OP * ckfun(pTHX_ OP *op, GV *namegv, SV *ckobj)
 
@@ -11784,17 +11632,17 @@ It is intended to be called in this manner:
 
     entersubop = ckfun(aTHX_ entersubop, namegv, ckobj);
 
-In this call, I<entersubop> is a pointer to the C<entersub> op,
-which may be replaced by the check function, and I<namegv> supplies
+In this call, C<entersubop> is a pointer to the C<entersub> op,
+which may be replaced by the check function, and C<namegv> supplies
 the name that should be used by the check function to refer
 to the callee of the C<entersub> op if it needs to emit any diagnostics.
 It is permitted to apply the check function in non-standard situations,
 such as to a call to a different subroutine or to a method call.
 
-I<namegv> may not actually be a GV.  For efficiency, perl may pass a
+C<namegv> may not actually be a GV.  For efficiency, perl may pass a
 CV or other SV instead.  Whatever is passed can be used as the first
 argument to L</cv_name>.  You can force perl to pass a GV by including
-C<CALL_CHECKER_REQUIRE_GV> in the I<flags>.
+C<CALL_CHECKER_REQUIRE_GV> in the C<flags>.
 
 The current setting for a particular CV can be retrieved by
 L</cv_get_call_checker>.
@@ -11903,6 +11751,8 @@ Perl_ck_subr(pTHX_ OP *o)
                                     ? -(SSize_t)len : (SSize_t)len,
                         0
 		    );
+                    if (SvREADONLY(*const_class))
+                        SvREADONLY_on(shared);
 		    SvREFCNT_dec(*const_class);
 		    *const_class = shared;
 		}
@@ -11947,9 +11797,7 @@ Perl_ck_svconst(pTHX_ OP *o)
     SV * const sv = cSVOPo->op_sv;
     PERL_ARGS_ASSERT_CK_SVCONST;
     PERL_UNUSED_CONTEXT;
-#ifdef PERL_OLD_COPY_ON_WRITE
-    if (SvIsCOW(sv)) sv_force_normal(sv);
-#elif defined(PERL_NEW_COPY_ON_WRITE)
+#ifdef PERL_COPY_ON_WRITE
     /* Since the read-only flag may be used to protect a string buffer, we
        cannot do copy-on-write with existing read-only scalars that are not
        already copy-on-write scalars.  To allow $_ = "hello" to do COW with
@@ -12025,10 +11873,6 @@ Perl_ck_each(pTHX_ OP *o)
     dVAR;
     OP *kid = o->op_flags & OPf_KIDS ? cUNOPo->op_first : NULL;
     const unsigned orig_type  = o->op_type;
-    const unsigned array_type = orig_type == OP_EACH ? OP_AEACH
-	                      : orig_type == OP_KEYS ? OP_AKEYS : OP_AVALUES;
-    const unsigned ref_type   = orig_type == OP_EACH ? OP_REACH
-	                      : orig_type == OP_KEYS ? OP_RKEYS : OP_RVALUES;
 
     PERL_ARGS_ASSERT_CK_EACH;
 
@@ -12039,7 +11883,9 @@ Perl_ck_each(pTHX_ OP *o)
 		break;
 	    case OP_PADAV:
 	    case OP_RV2AV:
-		CHANGE_TYPE(o, array_type);
+                OpTYPE_set(o, orig_type == OP_EACH ? OP_AEACH
+                            : orig_type == OP_KEYS ? OP_AKEYS
+                            :                        OP_AVALUES);
 		break;
 	    case OP_CONST:
 		if (kid->op_private == OPpCONST_BARE
@@ -12050,17 +11896,12 @@ Perl_ck_each(pTHX_ OP *o)
 		    /* we let ck_fun handle it */
 		    break;
 	    default:
-		CHANGE_TYPE(o, ref_type);
-		scalar(kid);
+                Perl_croak_nocontext(
+                    "Experimental %s on scalar is now forbidden",
+                    PL_op_desc[orig_type]);
+                break;
 	}
     }
-    /* if treating as a reference, defer additional checks to runtime */
-    if (o->op_type == ref_type) {
-	/* diag_listed_as: keys on reference is experimental */
-	Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__AUTODEREF),
-			      "%s is experimental", PL_op_desc[ref_type]);
-	return o;
-    }
     return ck_fun(o);
 }
 
@@ -12108,6 +11949,427 @@ 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:
+        /* undef counts as a scalar on the RHS:
+         *   (undef, $x) = ...;         # only 1 scalar on LHS: always safe
+         *   ($x, $y)    = (undef, $x); # 2 scalars on RHS: unsafe
+         */
+        if (rhs)
+            (*scalars_p)++;
+        flags = AAS_SAFE_SCALAR;
+        break;
+
+    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 */
 
@@ -12223,7 +12485,13 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
      * determines whether the op chain is convertible and calculates the
      * buffer size; the second pass populates the buffer and makes any
      * changes necessary to ops (such as moving consts to the pad on
-     * threaded builds)
+     * threaded builds).
+     *
+     * NB: for things like Coverity, note that both passes take the same
+     * path through the logic tree (except for 'if (pass)' bits), since
+     * both passes are following the same op_next chain; and in
+     * particular, if it would return early on the second pass, it would
+     * already have returned early on the first pass.
      */
     for (pass = 0; pass < 2; pass++) {
         OP *o                = orig_o;
@@ -12284,7 +12552,7 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
             break;
 
         default:
-            NOT_REACHED;
+            NOT_REACHED; /* NOTREACHED */
             return;
         }
 
@@ -12613,7 +12881,7 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 
         if (pass) {
             OP *mderef;
-            OP *p;
+            OP *p, *q;
 
             mderef = newUNOP_AUX(OP_MULTIDEREF, 0, NULL, arg_buf);
             if (index_skip == -1) {
@@ -12777,7 +13045,12 @@ S_maybe_multideref(pTHX_ OP *start, OP *orig_o, UV orig_action, U8 hints)
 
             /* excise and free the original tree, and replace with
              * the multideref op */
-            op_free(op_sibling_splice(top_op, NULL, -1, mderef));
+            p = op_sibling_splice(top_op, NULL, -1, mderef);
+            while (p) {
+                q = OpSIBLING(p);
+                op_free(p);
+                p = q;
+            }
             op_null(top_op);
         }
         else {
@@ -13130,32 +13403,33 @@ Perl_rpeep(pTHX_ OP *o)
                 assert(OpSIBLING(ns2)  == pad2);
                 assert(OpSIBLING(pad2) == ns3);
 
+                /* excise and delete ns2 */
+                op_sibling_splice(NULL, pad1, 1, NULL);
+                op_free(ns2);
+
+                /* excise pad1 and pad2 */
+                op_sibling_splice(NULL, o, 2, NULL);
+
                 /* create new listop, with children consisting of:
                  * a new pushmark, pad1, pad2. */
-		OpSIBLING_set(pad2, NULL);
 		newop = newLISTOP(OP_LIST, 0, pad1, pad2);
 		newop->op_flags |= OPf_PARENS;
 		newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
-                newpm = cUNOPx(newop)->op_first; /* pushmark */
 
-		/* Kill nextstate2 between padop1/padop2 */
-		op_free(ns2);
+                /* insert newop between o and ns3 */
+                op_sibling_splice(NULL, o, 0, newop);
 
+                /*fixup op_next chain */
+                newpm = cUNOPx(newop)->op_first; /* pushmark */
 		o    ->op_next = newpm;
 		newpm->op_next = pad1;
 		pad1 ->op_next = pad2;
 		pad2 ->op_next = newop; /* listop */
 		newop->op_next = ns3;
 
-		OpSIBLING_set(o, newop);
-		OpSIBLING_set(newop, ns3);
-                newop->op_lastsib = 0;
-
-		newop->op_flags = (newop->op_flags & ~OPf_WANT) | OPf_WANT_VOID;
-
 		/* Ensure pushmark has this flag if padops do */
 		if (pad1->op_flags & OPf_MOD && pad2->op_flags & OPf_MOD) {
-		    o->op_next->op_flags |= OPf_MOD;
+		    newpm->op_flags |= OPf_MOD;
 		}
 
 		break;
@@ -13262,7 +13536,7 @@ Perl_rpeep(pTHX_ OP *o)
                     o->op_flags &=~ OPf_KIDS;
                     /* stub is a baseop; repeat is a binop */
                     STATIC_ASSERT_STMT(sizeof(OP) <= sizeof(BINOP));
-                    CHANGE_TYPE(o, OP_STUB);
+                    OpTYPE_set(o, OP_STUB);
                     o->op_private = 0;
                     break;
                 }
@@ -13494,7 +13768,7 @@ Perl_rpeep(pTHX_ OP *o)
                  * *always* formerly a pushmark */
                 assert(o->op_type == OP_PUSHMARK);
                 o->op_next = followop;
-                CHANGE_TYPE(o, OP_PADRANGE);
+                OpTYPE_set(o, OP_PADRANGE);
                 o->op_targ = base;
                 /* bit 7: INTRO; bit 6..0: count */
                 o->op_private = (intro | count);
@@ -13580,7 +13854,7 @@ Perl_rpeep(pTHX_ OP *o)
 		    o->op_private |= o->op_next->op_private & (OPpLVAL_INTRO
 							       | OPpOUR_INTRO);
 		    o->op_next = o->op_next->op_next;
-                    CHANGE_TYPE(o, OP_GVSV);
+                    OpTYPE_set(o, OP_GVSV);
 		}
 	    }
 	    else if (o->op_next->op_type == OP_READLINE
@@ -13588,7 +13862,7 @@ Perl_rpeep(pTHX_ OP *o)
 		    && (o->op_next->op_next->op_flags & OPf_STACKED))
 	    {
 		/* Turn "$a .= <FH>" into an OP_RCATLINE. AMS 20010917 */
-                CHANGE_TYPE(o, OP_RCATLINE);
+                OpTYPE_set(o, OP_RCATLINE);
 		o->op_flags |= OPf_STACKED;
 		op_null(o->op_next->op_next);
 		op_null(o->op_next);
@@ -13854,8 +14128,7 @@ Perl_rpeep(pTHX_ OP *o)
 
 	    rv2av = OpSIBLING(ourmark);
 	    if (rv2av && rv2av->op_type == OP_RV2AV && !OpHAS_SIBLING(rv2av)
-		&& rv2av->op_flags == (OPf_WANT_LIST | OPf_KIDS)
-		&& enter->op_flags == (OPf_WANT_LIST | OPf_KIDS)) {
+		&& rv2av->op_flags == (OPf_WANT_LIST | OPf_KIDS)) {
 		/* We're just reversing a single array.  */
 		rv2av->op_flags = OPf_WANT_SCALAR | OPf_KIDS | OPf_REF;
 		enter->op_flags |= OPf_STACKED;
@@ -13892,7 +14165,7 @@ Perl_rpeep(pTHX_ OP *o)
 		    sv_rvweaken(sv);
 		    SvREADONLY_on(sv);
 		}
-                CHANGE_TYPE(o, OP_CONST);
+                OpTYPE_set(o, OP_CONST);
 		o->op_flags |= OPf_SPECIAL;
 		cSVOPo->op_sv = sv;
 	    }
@@ -13941,28 +14214,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, undef) = ... */
+            ) {
+                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 = 
@@ -13998,7 +14342,7 @@ Perl_peep(pTHX_ OP *o)
 
 =for apidoc Ao||custom_op_xop
 Return the XOP structure for a given custom op.  This macro should be
-considered internal to OP_NAME and the other access macros: use them instead.
+considered internal to C<OP_NAME> and the other access macros: use them instead.
 This macro does call a function.  Prior
 to 5.19.6, this was implemented as a
 function.
@@ -14075,7 +14419,7 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
 		    any.xop_peep = xop->xop_peep;
 		    break;
 		default:
-		    NOT_REACHED;
+		    NOT_REACHED; /* NOTREACHED */
 		    break;
 		}
 	    } else {
@@ -14093,7 +14437,7 @@ Perl_custom_op_get_field(pTHX_ const OP *o, const xop_flags_enum field)
 		    any.xop_peep = XOPd_xop_peep;
 		    break;
 		default:
-		    NOT_REACHED;
+		    NOT_REACHED; /* NOTREACHED */
 		    break;
 		}
 	    }
@@ -14135,8 +14479,8 @@ Perl_custom_op_register(pTHX_ Perl_ppaddr_t ppaddr, const XOP *xop)
 =for apidoc core_prototype
 
 This function assigns the prototype of the named core function to C<sv>, or
-to a new mortal SV if C<sv> is NULL.  It returns the modified C<sv>, or
-NULL if the core function has no prototype.  C<code> is a code as returned
+to a new mortal SV if C<sv> is C<NULL>.  It returns the modified C<sv>, or
+C<NULL> if the core function has no prototype.  C<code> is a code as returned
 by C<keyword()>.  It must not be equal to 0.
 
 =cut
@@ -14172,16 +14516,16 @@ Perl_core_prototype(pTHX_ SV *sv, const char *name, const int code,
     case KEY_x     : case KEY_xor    :
 	if (!opnum) return NULL; nullret = TRUE; goto findopnum;
     case KEY_glob:    retsetpvs("_;", OP_GLOB);
-    case KEY_keys:    retsetpvs("+", OP_KEYS);
-    case KEY_values:  retsetpvs("+", OP_VALUES);
-    case KEY_each:    retsetpvs("+", OP_EACH);
-    case KEY_push:    retsetpvs("+@", OP_PUSH);
-    case KEY_unshift: retsetpvs("+@", OP_UNSHIFT);
-    case KEY_pop:     retsetpvs(";+", OP_POP);
-    case KEY_shift:   retsetpvs(";+", OP_SHIFT);
+    case KEY_keys:    retsetpvs("\\[%@]", OP_KEYS);
+    case KEY_values:  retsetpvs("\\[%@]", OP_VALUES);
+    case KEY_each:    retsetpvs("\\[%@]", OP_EACH);
+    case KEY_push:    retsetpvs("\\@@", OP_PUSH);
+    case KEY_unshift: retsetpvs("\\@@", OP_UNSHIFT);
+    case KEY_pop:     retsetpvs(";\\@", OP_POP);
+    case KEY_shift:   retsetpvs(";\\@", OP_SHIFT);
     case KEY_pos:     retsetpvs(";\\[$*]", OP_POS);
     case KEY_splice:
-	retsetpvs("+;$$@", OP_SPLICE);
+	retsetpvs("\\@;$$@", OP_SPLICE);
     case KEY___FILE__: case KEY___LINE__: case KEY___PACKAGE__:
 	retsetpvs("", 0);
     case KEY_evalbytes:
@@ -14364,12 +14708,12 @@ hook variables.
 
 Puts a C function into the chain of check functions for a specified op
 type.  This is the preferred way to manipulate the L</PL_check> array.
-I<opcode> specifies which type of op is to be affected.  I<new_checker>
+C<opcode> specifies which type of op is to be affected.  C<new_checker>
 is a pointer to the C function that is to be added to that opcode's
-check chain, and I<old_checker_p> points to the storage location where a
+check chain, and C<old_checker_p> points to the storage location where a
 pointer to the next function in the chain will be stored.  The value of
-I<new_pointer> is written into the L</PL_check> array, while the value
-previously stored there is written to I<*old_checker_p>.
+C<new_pointer> is written into the L</PL_check> array, while the value
+previously stored there is written to C<*old_checker_p>.
 
 The function should be defined like this:
 
@@ -14379,30 +14723,30 @@ It is intended to be called in this manner:
 
     new_checker(aTHX_ op)
 
-I<old_checker_p> should be defined like this:
+C<old_checker_p> should be defined like this:
 
     static Perl_check_t old_checker_p;
 
 L</PL_check> is global to an entire process, and a module wishing to
 hook op checking may find itself invoked more than once per process,
 typically in different threads.  To handle that situation, this function
-is idempotent.  The location I<*old_checker_p> must initially (once
+is idempotent.  The location C<*old_checker_p> must initially (once
 per process) contain a null pointer.  A C variable of static duration
 (declared at file scope, typically also marked C<static> to give
 it internal linkage) will be implicitly initialised appropriately,
 if it does not have an explicit initialiser.  This function will only
-actually modify the check chain if it finds I<*old_checker_p> to be null.
+actually modify the check chain if it finds C<*old_checker_p> to be null.
 This function is also thread safe on the small scale.  It uses appropriate
 locking to avoid race conditions in accessing L</PL_check>.
 
-When this function is called, the function referenced by I<new_checker>
-must be ready to be called, except for I<*old_checker_p> being unfilled.
-In a threading situation, I<new_checker> may be called immediately,
-even before this function has returned.  I<*old_checker_p> will always
-be appropriately set before I<new_checker> is called.  If I<new_checker>
+When this function is called, the function referenced by C<new_checker>
+must be ready to be called, except for C<*old_checker_p> being unfilled.
+In a threading situation, C<new_checker> may be called immediately,
+even before this function has returned.  C<*old_checker_p> will always
+be appropriately set before C<new_checker> is called.  If C<new_checker>
 decides not to do anything special with an op that it is given (which
 is the usual case for most uses of op check hooking), it must chain the
-check function referenced by I<*old_checker_p>.
+check function referenced by C<*old_checker_p>.
 
 If you want to influence compilation of calls to a specific subroutine,
 then use L</cv_set_call_checker> rather than hooking checking of all
@@ -14470,11 +14814,5 @@ const_av_xsub(pTHX_ CV* cv)
 }
 
 /*
- * Local variables:
- * c-indentation-style: bsd
- * c-basic-offset: 4
- * indent-tabs-mode: nil
- * End:
- *
  * ex: set ts=8 sts=4 sw=4 et:
  */