X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/f93695f990c755bfd70a59f0ac4caf55173fdb4a..2fdd76928f116a6e52e8f66669e8d76fcbe65ec6:/op.c

diff --git a/op.c b/op.c
index 5f25121..0de303c 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];		\
@@ -591,7 +594,7 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 	!(is_our ||
 	  isALPHA(name[1]) ||
 	  ((flags & SVf_UTF8) && isIDFIRST_utf8((U8 *)name+1)) ||
-	  (name[1] == '_' && (*name == '$' || len > 2))))
+	  (name[1] == '_' && len > 2)))
     {
 	if (!(flags & SVf_UTF8 && UTF8_IS_START(name[1]))
 	 && isASCII(name[1])
@@ -604,13 +607,6 @@ Perl_allocmy(pTHX_ const char *const name, const STRLEN len, const U32 flags)
 			      PL_parser->in_my == KEY_state ? "state" : "my"), flags & SVf_UTF8);
 	}
     }
-    else if (len == 2 && name[1] == '_' && !is_our)
-	/* diag_listed_as: Use of my $_ is experimental */
-	Perl_ck_warner_d(aTHX_ packWARN(WARN_EXPERIMENTAL__LEXICAL_TOPIC),
-			      "Use of %s $_ is experimental",
-			       PL_parser->in_my == KEY_state
-				 ? "state"
-				 : "my");
 
     /* allocate a spare slot and store the name in that slot */
 
@@ -716,10 +712,23 @@ Perl_op_free(pTHX_ OP *o)
         type = o->op_type;
 
         /* an op should only ever acquire op_private flags that we know about.
-         * If this fails, you may need to fix something in regen/op_private */
-        if (o->op_ppaddr == PL_ppaddr[o->op_type]) {
+         * If this fails, you may need to fix something in regen/op_private.
+         * Don't bother testing if:
+         *   * the op_ppaddr doesn't match the op; someone may have
+         *     overridden the op and be doing strange things with it;
+         *   * we've errored, as op flags are often left in an
+         *     inconsistent state then. Note that an error when
+         *     compiling the main program leaves PL_parser NULL, so
+         *     we can't spot faults in the main code, only
+         *     evaled/required code */
+#ifdef DEBUGGING
+        if (   o->op_ppaddr == PL_ppaddr[o->op_type]
+            && PL_parser
+            && !PL_parser->error_count)
+        {
             assert(!(o->op_private & ~PL_op_private_valid[type]));
         }
+#endif
 
         if (o->op_private & OPpREFCOUNTED) {
             switch (type) {
@@ -1180,11 +1189,12 @@ 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
 Perl_op_refcnt_lock(pTHX)
+  PERL_TSA_ACQUIRE(PL_op_mutex)
 {
 #ifdef USE_ITHREADS
     dVAR;
@@ -1195,6 +1205,7 @@ Perl_op_refcnt_lock(pTHX)
 
 void
 Perl_op_refcnt_unlock(pTHX)
+  PERL_TSA_RELEASE(PL_op_mutex)
 {
 #ifdef USE_ITHREADS
     dVAR;
@@ -1208,32 +1219,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 +1269,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 +1298,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 +1307,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 +1327,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 +1355,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 +1380,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 +1432,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 +1450,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 +1628,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 +1994,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 +2063,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 +2373,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 +2533,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 +2574,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 +2592,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 +2661,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 +2671,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 +2718,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:
@@ -2732,7 +2750,7 @@ S_lvref(pTHX_ OP *o, I32 type)
 		      : OP_DESC(o),
 		     PL_op_desc[type]));
     }
-    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)
@@ -2771,7 +2789,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;
@@ -2789,6 +2807,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 		OP *kid = cUNOPo->op_first;
 		CV *cv;
 		GV *gv;
+                SV *namesv;
 
 		if (kid->op_type != OP_PUSHMARK) {
 		    if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
@@ -2826,6 +2845,15 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 		    break;
 		if (CvLVALUE(cv))
 		    break;
+                if (flags & OP_LVALUE_NO_CROAK)
+                    return NULL;
+
+                namesv = cv_name(cv, NULL, 0);
+                yyerror_pv(Perl_form(aTHX_ "Can't modify non-lvalue "
+                                     "subroutine call of &%"SVf" in %s",
+                                     SVfARG(namesv), PL_op_desc[type]),
+                           SvUTF8(namesv));
+                return o;
 	    }
 	}
 	/* FALLTHROUGH */
@@ -2839,9 +2867,7 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 	yyerror(Perl_form(aTHX_ "Can't modify %s in %s",
 		     (o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)
 		      ? "do block"
-		      : (o->op_type == OP_ENTERSUB
-			? "non-lvalue subroutine call"
-			: OP_DESC(o))),
+		      : OP_DESC(o)),
 		     type ? PL_op_desc[type] : "local"));
 	return o;
 
@@ -2985,7 +3011,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;
@@ -3236,14 +3261,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;
@@ -3355,24 +3380,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
@@ -3403,7 +3430,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;
@@ -3826,11 +3853,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);
@@ -3894,9 +3921,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
@@ -4129,7 +4156,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 		s++;
 
 	    while (1) {
-		if (*s && strchr("@$%*", *s) && *++s
+		if (*s && (strchr("@$%", *s) || (!lex && *s == '*'))
+		       && *++s
 		       && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
 		    s++;
 		    sigil = TRUE;
@@ -4413,7 +4441,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() */
@@ -4444,10 +4472,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
@@ -4477,10 +4505,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
@@ -4501,16 +4529,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;
@@ -4520,10 +4543,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
@@ -4557,8 +4580,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>,
@@ -4591,7 +4614,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;
@@ -4644,8 +4667,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)
@@ -4659,16 +4681,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
 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.
 
 
@@ -4686,7 +4708,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;
@@ -4696,26 +4718,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);
 }
@@ -4724,7 +4739,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>.
 
@@ -4748,7 +4763,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;
@@ -4763,11 +4778,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.
 
@@ -4800,15 +4815,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)
@@ -4820,8 +4833,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
 */
@@ -4843,10 +4856,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);
 
@@ -4857,13 +4868,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
 */
@@ -4883,10 +4894,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);
@@ -4902,7 +4911,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);
 }
 
@@ -4916,11 +4925,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
 */
@@ -4934,11 +4943,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.
 
@@ -4959,7 +4968,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) {
@@ -4968,20 +4977,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)
@@ -5174,7 +5178,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;
@@ -5206,7 +5210,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 		    max = rfirst + diff;
 		if (!grows)
 		    grows = (tfirst < rfirst &&
-			     UNISKIP(tfirst) < UNISKIP(rfirst + diff));
+			     UVCHR_SKIP(tfirst) < UVCHR_SKIP(rfirst + diff));
 		rfirst += diff + 1;
 	    }
 	    tfirst += diff + 1;
@@ -5345,7 +5349,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
@@ -5361,7 +5365,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)
@@ -5786,8 +5790,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
@@ -5807,7 +5811,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;
@@ -5822,9 +5826,7 @@ Perl_newSVOP(pTHX_ I32 type, I32 flags, SV *sv)
 /*
 =for apidoc Am|OP *|newDEFSVOP|
 
-Constructs and returns an op to access C<$_>, either as a lexical
-variable (if declared as C<my $_>) in the current scope, or the
-global C<$_>.
+Constructs and returns an op to access C<$_>.
 
 =cut
 */
@@ -5832,15 +5834,7 @@ global C<$_>.
 OP *
 Perl_newDEFSVOP(pTHX)
 {
-    const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
 	return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
-    }
-    else {
-	OP * const o = newOP(OP_PADSV, 0);
-	o->op_targ = offset;
-	return o;
-    }
 }
 
 #ifdef USE_ITHREADS
@@ -5849,9 +5843,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.
@@ -5873,7 +5867,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));
@@ -5894,8 +5888,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.
 
@@ -5918,8 +5912,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.
 
@@ -5940,7 +5934,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;
@@ -6118,15 +6112,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.
@@ -6234,11 +6228,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.
 
@@ -6316,149 +6310,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.
@@ -6488,7 +6356,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;
@@ -6502,47 +6369,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) = ...
@@ -6554,13 +6398,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
@@ -6673,13 +6510,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
@@ -6699,10 +6536,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);
@@ -6761,12 +6598,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
@@ -7025,11 +6862,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
@@ -7100,10 +6937,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.
 
@@ -7169,11 +7006,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
@@ -7267,18 +7104,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
@@ -7365,7 +7202,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;
     }
@@ -7393,15 +7230,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
-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<sv> optionally supplies the variable that will be aliased to each
+item in turn; if null, it defaults to C<$_>.
+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.
@@ -7424,7 +7261,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
@@ -7457,13 +7294,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
 	}
     }
     else {
-        const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-	if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
-	    sv = newGVOP(OP_GV, 0, PL_defgv);
-	}
-	else {
-	    padoff = offset;
-	}
+	sv = newGVOP(OP_GV, 0, PL_defgv);
 	iterpflags |= OPpITER_DEF;
     }
 
@@ -7504,8 +7335,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 */
@@ -7518,8 +7350,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;
@@ -7528,7 +7360,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;
@@ -7540,7 +7372,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.
 
@@ -7614,7 +7446,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));
@@ -7644,9 +7476,10 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
     OP *o;
 
     PERL_ARGS_ASSERT_NEWGIVWHENOP;
+    PERL_UNUSED_ARG(entertarg); /* used to indicate targ of lexical $_ */
 
     enterop = S_alloc_LOGOP(aTHX_ enter_opcode, block, NULL);
-    enterop->op_targ = ((entertarg == NOT_IN_PAD) ? 0 : entertarg);
+    enterop->op_targ = 0;
     enterop->op_private = 0;
 
     o = newUNOP(leave_opcode, 0, (OP *) enterop);
@@ -7762,11 +7595,10 @@ 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> must be zero (it used to identity the pad slot of lexical $_).
 
 =cut
 */
@@ -7775,20 +7607,23 @@ OP *
 Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
 {
     PERL_ARGS_ASSERT_NEWGIVENOP;
+    PERL_UNUSED_ARG(defsv_off);
+
+    assert(!defsv_off);
     return newGIVWHENOP(
     	ref_array_or_hash(cond),
     	block,
 	OP_ENTERGIVEN, OP_LEAVEGIVEN,
-	defsv_off);
+	0);
 }
 
 /*
 =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.
 
@@ -7902,7 +7737,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">.
@@ -8152,14 +7987,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);
@@ -8390,7 +8224,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;
 }
 
@@ -8460,9 +8294,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);
@@ -8557,15 +8396,15 @@ 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,
+                                        cBOOL(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);
@@ -8966,15 +8805,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.)
@@ -9035,7 +8874,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
@@ -9066,7 +8905,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
     );
 }
 
@@ -9080,9 +8919,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__",
@@ -9127,7 +8964,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);
@@ -9285,12 +9124,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;
 
@@ -9311,12 +9150,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;
 
@@ -9335,7 +9174,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)) {
@@ -9360,7 +9199,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)) {
@@ -9374,7 +9213,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));
 }
@@ -9387,7 +9226,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;
     }
@@ -9684,7 +9523,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;
 	}
@@ -9835,7 +9674,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) */
@@ -9876,6 +9715,7 @@ Perl_ck_ftst(pTHX_ OP *o)
 	    op_free(o);
 	    return newop;
 	}
+	scalar((OP *) kid);
 	if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o->op_type))
 	    o->op_private |= OPpFT_ACCESS;
 	if (type != OP_STAT && type != OP_LSTAT
@@ -9981,17 +9821,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)
@@ -10216,7 +10052,6 @@ Perl_ck_grep(pTHX_ OP *o)
     LOGOP *gwop;
     OP *kid;
     const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
-    PADOFFSET offset;
 
     PERL_ARGS_ASSERT_CK_GREP;
 
@@ -10243,15 +10078,8 @@ Perl_ck_grep(pTHX_ OP *o)
 
     gwop = S_alloc_LOGOP(aTHX_ type, o, LINKLIST(kid));
     kid->op_next = (OP*)gwop;
-    offset = pad_findmy_pvs("$_", 0);
-    if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
-	o->op_private = gwop->op_private = 0;
-	gwop->op_targ = pad_alloc(type, SVs_PADTMP);
-    }
-    else {
-	o->op_private = gwop->op_private = OPpGREP_LEX;
-	gwop->op_targ = o->op_targ = offset;
-    }
+    o->op_private = gwop->op_private = 0;
+    gwop->op_targ = pad_alloc(type, SVs_PADTMP);
 
     kid = OpSIBLING(cLISTOPo->op_first);
     for (kid = OpSIBLING(kid); kid; kid = OpSIBLING(kid))
@@ -10334,7 +10162,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;
     }
@@ -10409,10 +10237,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);
         }
     }
     
@@ -10476,10 +10304,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;
 
@@ -10499,15 +10330,9 @@ Perl_ck_sassign(pTHX_ OP *o)
 OP *
 Perl_ck_match(pTHX_ OP *o)
 {
+    PERL_UNUSED_CONTEXT;
     PERL_ARGS_ASSERT_CK_MATCH;
 
-    if (o->op_type != OP_QR && PL_compcv) {
-	const PADOFFSET offset = pad_findmy_pvs("$_", 0);
-	if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
-	    o->op_targ = offset;
-	    o->op_private |= OPpTARGET_MY;
-	}
-    }
     if (o->op_type == OP_MATCH || o->op_type == OP_QR)
 	o->op_private |= OPpRUNTIME;
     return o;
@@ -10633,7 +10458,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:
@@ -10641,19 +10470,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.  */
@@ -10662,7 +10497,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) {
@@ -10676,6 +10511,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;
@@ -10770,7 +10606,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(
@@ -10838,7 +10675,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)));
 	}
@@ -10937,10 +10774,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);
 		}
 	    }
@@ -11098,7 +10933,7 @@ 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);
@@ -11135,11 +10970,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;
@@ -11192,7 +11027,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.
@@ -11206,14 +11041,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
@@ -11233,7 +11068,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)];
     }
@@ -11324,11 +11159,20 @@ OP *
 Perl_ck_entersub_args_list(pTHX_ OP *entersubop)
 {
     OP *aop;
+
     PERL_ARGS_ASSERT_CK_ENTERSUB_ARGS_LIST;
+
     aop = cUNOPx(entersubop)->op_first;
     if (!OpHAS_SIBLING(aop))
 	aop = cUNOPx(aop)->op_first;
     for (aop = OpSIBLING(aop); OpHAS_SIBLING(aop); aop = OpSIBLING(aop)) {
+        /* skip the extra attributes->import() call implicitly added in
+         * something like foo(my $x : bar)
+         */
+        if (   aop->op_type == OP_ENTERSUB
+            && (aop->op_flags & OPf_WANT) == OPf_WANT_VOID
+        )
+            continue;
         list(aop);
         op_lvalue(aop, OP_ENTERSUB);
     }
@@ -11346,7 +11190,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
@@ -11358,7 +11202,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
 */
@@ -11425,11 +11269,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;
@@ -11590,7 +11435,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.
@@ -11604,7 +11449,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
 */
@@ -11719,19 +11564,19 @@ Perl_ck_entersub_args_core(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 /*
 =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,
@@ -11739,7 +11584,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>.
 
@@ -11774,13 +11619,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)
 
@@ -11788,17 +11633,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>.
@@ -11907,6 +11752,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;
 		}
@@ -11951,9 +11798,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
@@ -12029,10 +11874,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;
 
@@ -12043,7 +11884,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
@@ -12054,17 +11897,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);
 }
 
@@ -12112,6 +11950,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 */
 
@@ -12868,6 +13127,11 @@ Perl_rpeep(pTHX_ OP *o)
 	}
 
       redo:
+
+        /* oldoldop -> oldop -> o should be a chain of 3 adjacent ops */
+        assert(!oldoldop || oldoldop->op_next == oldop);
+        assert(!oldop    || oldop->op_next    == o);
+
 	/* By default, this op has now been optimised. A couple of cases below
 	   clear this again.  */
 	o->op_opt = 1;
@@ -13145,32 +13409,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;
@@ -13188,9 +13453,10 @@ Perl_rpeep(pTHX_ OP *o)
 		    op_null(o);
 		    if (oldop)
 			oldop->op_next = nextop;
+                    o = nextop;
 		    /* Skip (old)oldop assignment since the current oldop's
 		       op_next already points to the next op.  */
-		    continue;
+		    goto redo;
 		}
 	    }
 	    break;
@@ -13277,7 +13543,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;
                 }
@@ -13402,9 +13668,17 @@ Perl_rpeep(pTHX_ OP *o)
                     break;
 
                 /* there's a biggest base we can fit into a
-                 * SAVEt_CLEARPADRANGE in pp_padrange */
-                if (intro && base >
-                        (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT)))
+                 * SAVEt_CLEARPADRANGE in pp_padrange.
+                 * (The sizeof() stuff will be constant-folded, and is
+                 * intended to avoid getting "comparison is always false"
+                 * compiler warnings)
+                 */
+                if (   intro
+                    && (8*sizeof(base) >
+                        8*sizeof(UV)-OPpPADRANGE_COUNTSHIFT-SAVE_TIGHT_SHIFT
+                        ? base : 0) >
+                        (UV_MAX >> (OPpPADRANGE_COUNTSHIFT+SAVE_TIGHT_SHIFT))
+                )
                     break;
 
                 /* Success! We've got another valid pad op to optimise away */
@@ -13509,7 +13783,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);
@@ -13587,7 +13861,8 @@ Perl_rpeep(pTHX_ OP *o)
 		    oldoldop = NULL;
 		    goto redo;
 		}
-		o = oldop;
+		o = oldop->op_next;
+                goto redo;
 	    }
 	    else if (o->op_next->op_type == OP_RV2SV) {
 		if (!(o->op_next->op_private & OPpDEREF)) {
@@ -13595,7 +13870,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
@@ -13603,7 +13878,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);
@@ -13869,8 +14144,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;
@@ -13885,6 +14159,11 @@ Perl_rpeep(pTHX_ OP *o)
 	    op_null(o);
 	    enter->op_private |= OPpITER_REVERSED;
 	    iter->op_private |= OPpITER_REVERSED;
+
+            oldoldop = NULL;
+            oldop    = ourlast;
+            o        = oldop->op_next;
+            goto redo;
 	    
 	    break;
 	}
@@ -13907,7 +14186,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;
 	    }
@@ -13956,28 +14235,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 = 
@@ -14013,7 +14363,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.
@@ -14150,8 +14500,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
@@ -14187,16 +14537,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:
@@ -14379,12 +14729,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:
 
@@ -14394,30 +14744,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
@@ -14485,11 +14835,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:
  */