X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/9ffcdca1f504cb09088413c074b35af4b7f247e3..9e4d7a131094a5a13132dec091678f488e28bdbc:/op.c

diff --git a/op.c b/op.c
index b2801c7..84d38cd 100644
--- a/op.c
+++ b/op.c
@@ -165,11 +165,36 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     OP *o;
     size_t opsz, space;
 
+    /* We only allocate ops from the slab during subroutine compilation.
+       We find the slab via PL_compcv, hence that must be non-NULL. It could
+       also be pointing to a subroutine which is now fully set up (CvROOT()
+       pointing to the top of the optree for that sub), or a subroutine
+       which isn't using the slab allocator. If our sanity checks aren't met,
+       don't use a slab, but allocate the OP directly from the heap.  */
     if (!PL_compcv || CvROOT(PL_compcv)
      || (CvSTART(PL_compcv) && !CvSLABBED(PL_compcv)))
 	return PerlMemShared_calloc(1, sz);
 
-    if (!CvSTART(PL_compcv)) { /* sneak it in here */
+#if defined(USE_ITHREADS) && IVSIZE > U32SIZE && IVSIZE > PTRSIZE
+    /* Work around a goof with alignment on our part. For sparc32 (and
+       possibly other architectures), if built with -Duse64bitint, the IV
+       op_pmoffset in struct pmop should be 8 byte aligned, but the slab
+       allocator is only providing 4 byte alignment. The real fix is to change
+       the IV to a type the same size as a pointer, such as size_t, but we
+       can't do that without breaking the ABI, which is a no-no in a maint
+       release. So instead, simply allocate struct pmop directly, which will be
+       suitably aligned:  */
+    if (sz == sizeof(struct pmop))
+	return PerlMemShared_calloc(1, sz);
+#endif
+
+    /* While the subroutine is under construction, the slabs are accessed via
+       CvSTART(), to avoid needing to expand PVCV by one pointer for something
+       unneeded at runtime. Once a subroutine is constructed, the slabs are
+       accessed via CvROOT(). So if CvSTART() is NULL, no slab has been
+       allocated yet.  See the commit message for 8be227ab5eaa23f2 for more
+       details.  */
+    if (!CvSTART(PL_compcv)) {
 	CvSTART(PL_compcv) =
 	    (OP *)(slab = S_new_slab(aTHX_ PERL_SLAB_SIZE));
 	CvSLABBED_on(PL_compcv);
@@ -180,6 +205,9 @@ Perl_Slab_Alloc(pTHX_ size_t sz)
     opsz = SIZE_TO_PSIZE(sz);
     sz = opsz + OPSLOT_HEADER_P;
 
+    /* The slabs maintain a free list of OPs. In particular, constant folding
+       will free up OPs, so it makes sense to re-use them where possible. A
+       freed up slot is used in preference to a new allocation.  */
     if (slab->opslab_freed) {
 	OP **too = &slab->opslab_freed;
 	o = *too;
@@ -283,7 +311,7 @@ Perl_Slab_to_rw(pTHX_ OPSLAB *const slab)
 }
 
 #else
-#  define Slab_to_rw(op)
+#  define Slab_to_rw(op)    NOOP
 #endif
 
 /* This cannot possibly be right, but it was copied from the old slab
@@ -520,9 +548,10 @@ S_bad_type_pv(pTHX_ I32 n, const char *t, const char *name, U32 flags, const OP
 }
 
 STATIC void
-S_bad_type_sv(pTHX_ I32 n, const char *t, SV *namesv, U32 flags, const OP *kid)
+S_bad_type_gv(pTHX_ I32 n, const char *t, GV *gv, U32 flags, const OP *kid)
 {
-    PERL_ARGS_ASSERT_BAD_TYPE_SV;
+    SV * const namesv = gv_ename(gv);
+    PERL_ARGS_ASSERT_BAD_TYPE_GV;
  
     yyerror_pv(Perl_form(aTHX_ "Type of arg %d to %"SVf" must be %s (not %s)",
 		 (int)n, SVfARG(namesv), t, OP_DESC(kid)), SvUTF8(namesv) | flags);
@@ -578,6 +607,13 @@ 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 */
 
@@ -647,12 +683,6 @@ S_op_destroy(pTHX_ OP *o)
     FreeOp(o);
 }
 
-#ifdef USE_ITHREADS
-#  define forget_pmop(a,b)	S_forget_pmop(aTHX_ a,b)
-#else
-#  define forget_pmop(a,b)	S_forget_pmop(aTHX_ a)
-#endif
-
 /* Destructor */
 
 void
@@ -711,9 +741,8 @@ Perl_op_free(pTHX_ OP *o)
     if (type == OP_NULL)
 	type = (OPCODE)o->op_targ;
 
-    if (o->op_slabbed) {
-	Slab_to_rw(OpSLAB(o));
-    }
+    if (o->op_slabbed)
+        Slab_to_rw(OpSLAB(o));
 
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
@@ -799,7 +828,7 @@ Perl_op_clear(pTHX_ OP *o)
 #endif
 	    if (still_valid) {
 		int try_downgrade = SvREFCNT(gv) == 2;
-		SvREFCNT_dec(gv);
+		SvREFCNT_dec_NN(gv);
 		if (try_downgrade)
 		    gv_try_downgrade(gv);
 	    }
@@ -870,7 +899,7 @@ clear_pmop:
 	if (!(cPMOPo->op_pmflags & PMf_CODELIST_PRIVATE))
 	    op_free(cPMOPo->op_code_list);
 	cPMOPo->op_code_list = NULL;
-	forget_pmop(cPMOPo, 1);
+	forget_pmop(cPMOPo);
 	cPMOPo->op_pmreplrootu.op_pmreplroot = NULL;
         /* we use the same protection as the "SAFE" version of the PM_ macros
          * here since sv_clean_all might release some PMOPs
@@ -913,9 +942,6 @@ S_cop_free(pTHX_ COP* cop)
 
 STATIC void
 S_forget_pmop(pTHX_ PMOP *const o
-#ifdef USE_ITHREADS
-	      , U32 flags
-#endif
 	      )
 {
     HV * const pmstash = PmopSTASH(o);
@@ -948,10 +974,6 @@ S_forget_pmop(pTHX_ PMOP *const o
     }
     if (PL_curpm == o) 
 	PL_curpm = NULL;
-#ifdef USE_ITHREADS
-    if (flags)
-	PmopSTASH_free(o);
-#endif
 }
 
 STATIC void
@@ -967,7 +989,7 @@ S_find_and_forget_pmops(pTHX_ OP *o)
 	    case OP_PUSHRE:
 	    case OP_MATCH:
 	    case OP_QR:
-		forget_pmop((PMOP*)kid, 0);
+		forget_pmop((PMOP*)kid);
 	    }
 	    find_and_forget_pmops(kid);
 	    kid = kid->op_sibling;
@@ -1393,7 +1415,7 @@ Perl_scalarvoid(pTHX_ OP *o)
                                                       PERL_PV_PRETTY_DUMP
                                                       | PERL_PV_ESCAPE_NOCLEAR
                                                       | PERL_PV_ESCAPE_UNI_DETECT));
-			SvREFCNT_dec(dsv);
+			SvREFCNT_dec_NN(dsv);
 		    }
 		}
 		else if (SvOK(sv)) {
@@ -1713,7 +1735,7 @@ S_finalize_op(pTHX_ OP* o)
     case OP_EXEC:
 	if ( o->op_sibling
 	    && (o->op_sibling->op_type == OP_NEXTSTATE || o->op_sibling->op_type == OP_DBSTATE)
-	    && ckWARN(WARN_SYNTAX))
+	    && ckWARN(WARN_EXEC))
 	    {
 		if (o->op_sibling->op_sibling) {
 		    const OPCODE type = o->op_sibling->op_sibling->op_type;
@@ -1762,7 +1784,7 @@ S_finalize_op(pTHX_ OP* o)
 		/* If op_sv is already a PADTMP/MY then it is being used by
 		 * some pad, so make a copy. */
 		sv_setsv(PAD_SVl(ix),cSVOPo->op_sv);
-		SvREADONLY_on(PAD_SVl(ix));
+		if (!SvIsCOW(PAD_SVl(ix))) SvREADONLY_on(PAD_SVl(ix));
 		SvREFCNT_dec(cSVOPo->op_sv);
 	    }
 	    else if (o->op_type != OP_METHOD_NAMED
@@ -1782,7 +1804,7 @@ S_finalize_op(pTHX_ OP* o)
 		SvPADTMP_on(cSVOPo->op_sv);
 		PAD_SETSV(ix, cSVOPo->op_sv);
 		/* XXX I don't know how this isn't readonly already. */
-		SvREADONLY_on(PAD_SVl(ix));
+		if (!SvIsCOW(PAD_SVl(ix))) SvREADONLY_on(PAD_SVl(ix));
 	    }
 	    cSVOPo->op_sv = NULL;
 	    o->op_targ = ix;
@@ -1803,13 +1825,13 @@ S_finalize_op(pTHX_ OP* o)
 
 	/* Make the CONST have a shared SV */
 	svp = cSVOPx_svp(((BINOP*)o)->op_last);
-	if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv))
+	if ((!SvIsCOW(sv = *svp))
 	    && SvTYPE(sv) < SVt_PVMG && !SvROK(sv)) {
 	    key = SvPV_const(sv, keylen);
 	    lexname = newSVpvn_share(key,
 		SvUTF8(sv) ? -(I32)keylen : (I32)keylen,
 		0);
-	    SvREFCNT_dec(sv);
+	    SvREFCNT_dec_NN(sv);
 	    *svp = lexname;
 	}
 
@@ -2077,11 +2099,12 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
 	/* FALL THROUGH */
     case OP_ASLICE:
     case OP_HSLICE:
-	if (type == OP_LEAVESUBLV)
-	    o->op_private |= OPpMAYBE_LVSUB;
 	localize = 1;
 	/* FALL THROUGH */
     case OP_AASSIGN:
+	if (type == OP_LEAVESUBLV)
+	    o->op_private |= OPpMAYBE_LVSUB;
+	/* FALL THROUGH */
     case OP_NEXTSTATE:
     case OP_DBSTATE:
        PL_modcount = RETURN_UNLIMITED_NUMBER;
@@ -2146,9 +2169,6 @@ Perl_op_lvalue_flags(pTHX_ OP *o, I32 type, U32 flags)
       lvalue_func:
 	if (type == OP_LEAVESUBLV)
 	    o->op_private |= OPpMAYBE_LVSUB;
-	pad_free(o->op_targ);
-	o->op_targ = pad_alloc(o->op_type, SVs_PADMY);
-	assert(SvTYPE(PAD_SV(o->op_targ)) == SVt_NULL);
 	if (o->op_flags & OPf_KIDS)
 	    op_lvalue(cBINOPo->op_first->op_sibling, type);
 	break;
@@ -3126,10 +3146,10 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 
 	    while (1) {
 		if (*s && strchr("@$%*", *s) && *++s
-		       && (isALNUM(*s) || UTF8_IS_CONTINUED(*s))) {
+		       && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s))) {
 		    s++;
 		    sigil = TRUE;
-		    while (*s && (isALNUM(*s) || UTF8_IS_CONTINUED(*s)))
+		    while (*s && (isWORDCHAR(*s) || UTF8_IS_CONTINUED(*s)))
 			s++;
 		    while (*s && (strchr(", \t\n", *s)))
 			s++;
@@ -3209,7 +3229,7 @@ S_op_integerize(pTHX_ OP *o)
 }
 
 static OP *
-S_fold_constants(pTHX_ register OP *o)
+S_fold_constants(pTHX_ OP *o)
 {
     dVAR;
     OP * VOL curop;
@@ -3234,6 +3254,7 @@ S_fold_constants(pTHX_ register OP *o)
     case OP_LCFIRST:
     case OP_UC:
     case OP_LC:
+    case OP_FC:
     case OP_SLT:
     case OP_SGT:
     case OP_SLE:
@@ -3359,7 +3380,7 @@ S_fold_constants(pTHX_ register OP *o)
 }
 
 static OP *
-S_gen_constant_list(pTHX_ register OP *o)
+S_gen_constant_list(pTHX_ OP *o)
 {
     dVAR;
     OP *curop;
@@ -3798,7 +3819,7 @@ Perl_mad_free(pTHX_ MADPROP* mp)
     case MAD_NULL:
 	break;
     case MAD_PV:
-	Safefree((char*)mp->mad_val);
+	Safefree(mp->mad_val);
 	break;
     case MAD_OP:
 	if (mp->mad_vlen)	/* vlen holds "strong/weak" boolean */
@@ -4376,7 +4397,7 @@ S_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 
     if(del && rlen == tlen) {
 	Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Useless use of /d modifier in transliteration operator"); 
-    } else if(rlen > tlen) {
+    } else if(rlen > tlen && !complement) {
 	Perl_ck_warner(aTHX_ packWARN(WARN_MISC), "Replacement list is longer than search list");
     }
 
@@ -4550,27 +4571,37 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 
     LINKLIST(expr);
 
-    /* fix up DO blocks; treat each one as a separate little sub */
+    /* fix up DO blocks; treat each one as a separate little sub;
+     * also, mark any arrays as LIST/REF */
 
     if (expr->op_type == OP_LIST) {
 	OP *o;
 	for (o = cLISTOPx(expr)->op_first; o; o = o->op_sibling) {
+
+            if (o->op_type == OP_PADAV || o->op_type == OP_RV2AV) {
+                assert( !(o->op_flags  & OPf_WANT));
+                /* push the array rather than its contents. The regex
+                 * engine will retrieve and join the elements later */
+                o->op_flags |= (OPf_WANT_LIST | OPf_REF);
+                continue;
+            }
+
 	    if (!(o->op_type == OP_NULL && (o->op_flags & OPf_SPECIAL)))
 		continue;
 	    o->op_next = NULL; /* undo temporary hack from above */
 	    scalar(o);
 	    LINKLIST(o);
 	    if (cLISTOPo->op_first->op_type == OP_LEAVE) {
-		LISTOP *leave = cLISTOPx(cLISTOPo->op_first);
+		LISTOP *leaveop = cLISTOPx(cLISTOPo->op_first);
 		/* skip ENTER */
-		assert(leave->op_first->op_type == OP_ENTER);
-		assert(leave->op_first->op_sibling);
-		o->op_next = leave->op_first->op_sibling;
-		/* skip LEAVE */
-		assert(leave->op_flags & OPf_KIDS);
-		assert(leave->op_last->op_next = (OP*)leave);
-		leave->op_next = NULL; /* stop on last op */
-		op_null((OP*)leave);
+		assert(leaveop->op_first->op_type == OP_ENTER);
+		assert(leaveop->op_first->op_sibling);
+		o->op_next = leaveop->op_first->op_sibling;
+		/* skip leave */
+		assert(leaveop->op_flags & OPf_KIDS);
+		assert(leaveop->op_last->op_next == (OP*)leaveop);
+		leaveop->op_next = NULL; /* stop on last op */
+		op_null((OP*)leaveop);
 	    }
 	    else {
 		/* skip SCOPE */
@@ -4588,6 +4619,12 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 		finalize_optree(o);
 	}
     }
+    else if (expr->op_type == OP_PADAV || expr->op_type == OP_RV2AV) {
+        assert( !(expr->op_flags  & OPf_WANT));
+        /* push the array rather than its contents. The regex
+         * engine will retrieve and join the elements later */
+        expr->op_flags |= (OPf_WANT_LIST | OPf_REF);
+    }
 
     PL_hints |= HINT_BLOCK_SCOPE;
     pm = (PMOP*)o;
@@ -4597,6 +4634,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 	U32 rx_flags = pm->op_pmflags & RXf_PMf_COMPILETIME;
 	regexp_engine const *eng = current_re_engine();
 
+        if (o->op_flags & OPf_SPECIAL)
+            rx_flags |= RXf_SPLIT;
+
 	if (!has_code || !eng->op_comp) {
 	    /* compile-time simple constant pattern */
 
@@ -4650,7 +4690,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 
 		/* attach the anon CV to the pad so that
 		 * pad_fixup_inner_anons() can find it */
-		if (cv) (void)pad_add_anon(cv, o->op_type);
+		(void)pad_add_anon(cv, o->op_type);
 		SvREFCNT_inc_simple_void(cv);
 	    }
 	    else {
@@ -4673,6 +4713,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg, I32 floor)
 	    pm->op_pmflags |= PMf_CODELIST_PRIVATE;
 	}
 
+        if (o->op_flags & OPf_SPECIAL)
+            pm->op_pmflags |= PMf_SPLIT;
+
 	/* the OP_REGCMAYBE is a placeholder in the non-threaded case
 	 * to allow its op_next to be pointed past the regcomp and
 	 * preceding stacking ops;
@@ -4936,7 +4979,7 @@ Perl_newGVOP(pTHX_ I32 type, I32 flags, GV *gv)
 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
-must have been allocated using L</PerlMemShared_malloc>; the memory will
+must have been allocated using C<PerlMemShared_malloc>; the memory will
 be freed when the op is destroyed.
 
 =cut
@@ -5318,7 +5361,7 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
 }
 
 STATIC I32
-S_is_list_assignment(pTHX_ register const OP *o)
+S_is_list_assignment(pTHX_ const OP *o)
 {
     unsigned type;
     U8 flags;
@@ -5589,7 +5632,6 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			    = MUTABLE_GV(cSVOPx(tmpop)->op_sv);
 			cSVOPx(tmpop)->op_sv = NULL;	/* steal it */
 #endif
-			pm->op_pmflags |= PMf_ONCE;
 			tmpop = cUNOPo->op_first;	/* to list (nulled) */
 			tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
 			tmpop->op_sibling = NULL;	/* don't free split */
@@ -5604,9 +5646,22 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
                    if (PL_modcount < RETURN_UNLIMITED_NUMBER &&
 		      ((LISTOP*)right)->op_last->op_type == OP_CONST)
 		    {
-			SV *sv = ((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+			SV ** const svp =
+			    &((SVOP*)((LISTOP*)right)->op_last)->op_sv;
+			SV * const sv = *svp;
 			if (SvIOK(sv) && SvIVX(sv) == 0)
+			{
+			  if (right->op_private & OPpSPLIT_IMPLIM) {
+			    /* our own SV, created in ck_split */
+			    SvREADONLY_off(sv);
 			    sv_setiv(sv, PL_modcount+1);
+			  }
+			  else {
+			    /* SV may belong to someone else */
+			    SvREFCNT_dec(sv);
+			    *svp = newSViv(PL_modcount+1);
+			  }
+			}
 		    }
 		}
 	    }
@@ -5632,7 +5687,7 @@ 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 L</PL_curcop> (or L</PL_compiling>).
+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
 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>
@@ -6412,7 +6467,7 @@ Perl_newFOROP(pTHX_ I32 flags, OP *sv, OP *expr, OP *block, OP *cont)
     {
 	/* Basically turn for($x..$y) into the same as for($x,$y), but we
 	 * set the STACKED flag to indicate that these values are to be
-	 * treated as min/max values by 'pp_iterinit'.
+	 * treated as min/max values by 'pp_enteriter'.
 	 */
 	const UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
 	LOGOP* const range = (LOGOP*) flip->op_first;
@@ -6754,52 +6809,61 @@ void
 Perl_cv_ckproto_len_flags(pTHX_ const CV *cv, const GV *gv, const char *p,
 		    const STRLEN len, const U32 flags)
 {
-    const char * const cvp = SvROK(cv) ? "" : CvPROTO(cv);
-    const STRLEN clen = CvPROTOLEN(cv);
+    SV *name = NULL, *msg;
+    const char * cvp = SvROK(cv) ? "" : CvPROTO(cv);
+    STRLEN clen = CvPROTOLEN(cv), plen = len;
 
     PERL_ARGS_ASSERT_CV_CKPROTO_LEN_FLAGS;
 
-    if (((!p != !cvp) /* One has prototype, one has not.  */
-	|| (p && (
-		  (flags & SVf_UTF8) == SvUTF8(cv)
-		   ? len != clen || memNE(cvp, p, len)
-		   : flags & SVf_UTF8
-		      ? bytes_cmp_utf8((const U8 *)cvp, clen,
-				       (const U8 *)p, len)
-		      : bytes_cmp_utf8((const U8 *)p, len,
-				       (const U8 *)cvp, clen)
-		 )
-	   )
-        )
-	 && ckWARN_d(WARN_PROTOTYPE)) {
-	SV* const msg = sv_newmortal();
-	SV* name = NULL;
+    if (p == NULL && cvp == NULL)
+	return;
 
-	if (gv)
-	{
-	  if (isGV(gv))
-	    gv_efullname3(name = sv_newmortal(), gv, NULL);
-	  else if (SvPOK(gv) && *SvPVX((SV *)gv) == '&')
-	    name = newSVpvn_flags(SvPVX((SV *)gv)+1, SvCUR(gv)-1,
-				  SvUTF8(gv)|SVs_TEMP);
-	  else name = (SV *)gv;
-	}
-	sv_setpvs(msg, "Prototype mismatch:");
-	if (name)
-	    Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name));
-	if (cvp)
-	    Perl_sv_catpvf(aTHX_ msg, " (%"SVf")",
-		SVfARG(newSVpvn_flags(cvp,clen, SvUTF8(cv)|SVs_TEMP))
-	    );
-	else
-	    sv_catpvs(msg, ": none");
-	sv_catpvs(msg, " vs ");
-	if (p)
-	    Perl_sv_catpvf(aTHX_ msg, "(%"SVf")", SVfARG(newSVpvn_flags(p, len, flags | SVs_TEMP)));
-	else
-	    sv_catpvs(msg, "none");
-	Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, SVfARG(msg));
+    if (!ckWARN_d(WARN_PROTOTYPE))
+	return;
+
+    if (p && cvp) {
+	p = S_strip_spaces(aTHX_ p, &plen);
+	cvp = S_strip_spaces(aTHX_ cvp, &clen);
+	if ((flags & SVf_UTF8) == SvUTF8(cv)) {
+	    if (plen == clen && memEQ(cvp, p, plen))
+		return;
+	} else {
+	    if (flags & SVf_UTF8) {
+		if (bytes_cmp_utf8((const U8 *)cvp, clen, (const U8 *)p, plen) == 0)
+		    return;
+            }
+	    else {
+		if (bytes_cmp_utf8((const U8 *)p, plen, (const U8 *)cvp, clen) == 0)
+		    return;
+	    }
+	}
     }
+
+    msg = sv_newmortal();
+
+    if (gv)
+    {
+	if (isGV(gv))
+	    gv_efullname3(name = sv_newmortal(), gv, NULL);
+	else if (SvPOK(gv) && *SvPVX((SV *)gv) == '&')
+	    name = newSVpvn_flags(SvPVX((SV *)gv)+1, SvCUR(gv)-1, SvUTF8(gv)|SVs_TEMP);
+	else name = (SV *)gv;
+    }
+    sv_setpvs(msg, "Prototype mismatch:");
+    if (name)
+	Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, SVfARG(name));
+    if (cvp)
+	Perl_sv_catpvf(aTHX_ msg, " (%"UTF8f")", 
+	    UTF8fARG(SvUTF8(cv),clen,cvp)
+	);
+    else
+	sv_catpvs(msg, ": none");
+    sv_catpvs(msg, " vs ");
+    if (p)
+	Perl_sv_catpvf(aTHX_ msg, "(%"UTF8f")", UTF8fARG(flags & SVf_UTF8,len,p));
+    else
+	sv_catpvs(msg, "none");
+    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, SVfARG(msg));
 }
 
 static void const_sv_xsub(pTHX_ CV* cv);
@@ -6912,6 +6976,64 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
     return sv;
 }
 
+static bool
+S_already_defined(pTHX_ CV *const cv, OP * const block, OP * const o,
+			PADNAME * const name, SV ** const const_svp)
+{
+    assert (cv);
+    assert (o || name);
+    assert (const_svp);
+    if ((!block
+#ifdef PERL_MAD
+	 || block->op_type == OP_NULL
+#endif
+	 )) {
+	if (CvFLAGS(PL_compcv)) {
+	    /* might have had built-in attrs applied */
+	    const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
+	    if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && pureperl
+	     && ckWARN(WARN_MISC))
+	    {
+		/* protect against fatal warnings leaking compcv */
+		SAVEFREESV(PL_compcv);
+		Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
+		SvREFCNT_inc_simple_void_NN(PL_compcv);
+	    }
+	    CvFLAGS(cv) |=
+		(CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS
+		  & ~(CVf_LVALUE * pureperl));
+	}
+	return FALSE;
+    }
+
+    /* redundant check for speed: */
+    if (CvCONST(cv) || ckWARN(WARN_REDEFINE)) {
+	const line_t oldline = CopLINE(PL_curcop);
+	SV *namesv = o
+	    ? cSVOPo->op_sv
+	    : sv_2mortal(newSVpvn_utf8(
+		PadnamePV(name)+1,PadnameLEN(name)-1, PadnameUTF8(name)
+	      ));
+	if (PL_parser && PL_parser->copline != NOLINE)
+            /* This ensures that warnings are reported at the first
+               line of a redefinition, not the last.  */
+	    CopLINE_set(PL_curcop, PL_parser->copline);
+	/* protect against fatal warnings leaking compcv */
+	SAVEFREESV(PL_compcv);
+	report_redefined_cv(namesv, cv, const_svp);
+	SvREFCNT_inc_simple_void_NN(PL_compcv);
+	CopLINE_set(PL_curcop, oldline);
+    }
+#ifdef PERL_MAD
+    if (!PL_minus_c)	/* keep old one around for madskills */
+#endif
+    {
+	/* (PL_madskills unset in used file.) */
+	SvREFCNT_dec(cv);
+    }
+    return TRUE;
+}
+
 CV *
 Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
@@ -6921,8 +7043,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     const char *ps;
     STRLEN ps_len = 0; /* init it to avoid false uninit warning from icc */
     U32 ps_utf8 = 0;
-    register CV *cv = NULL;
-    register CV *compcv = PL_compcv;
+    CV *cv = NULL;
+    CV *compcv = PL_compcv;
     SV *const_sv;
     PADNAME *name;
     PADOFFSET pax = o->op_targ;
@@ -6970,6 +7092,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 
     if (PL_parser && PL_parser->error_count) {
 	op_free(block);
+	SvREFCNT_dec(PL_compcv);
+	PL_compcv = 0;
 	goto done;
     }
 
@@ -7026,49 +7150,14 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
             cv_ckproto_len_flags(cv, (GV *)name, ps, ps_len, ps_utf8);
 	/* already defined? */
 	if (exists) {
-	    if ((!block
-#ifdef PERL_MAD
-		 || block->op_type == OP_NULL
-#endif
-		 )) {
-		if (CvFLAGS(compcv)) {
-		    /* might have had built-in attrs applied */
-		    const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
-		    if (CvLVALUE(compcv) && ! CvLVALUE(cv) && pureperl
-		     && ckWARN(WARN_MISC))
-			Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
-		    CvFLAGS(cv) |=
-			(CvFLAGS(compcv) & CVf_BUILTIN_ATTRS
-			  & ~(CVf_LVALUE * pureperl));
-		}
+	    if (S_already_defined(aTHX_ cv, block, NULL, name, &const_sv))
+		cv = NULL;
+	    else {
 		if (attrs) goto attrs;
 		/* just a "sub foo;" when &foo is already defined */
 		SAVEFREESV(compcv);
 		goto done;
 	    }
-	    else {
-		/* redundant check that avoids creating the extra SV
-		   most of the time: */
-		if (const_sv || ckWARN(WARN_REDEFINE)) {
-		    const line_t oldline = CopLINE(PL_curcop);
-		    SV *noamp = sv_2mortal(newSVpvn_utf8(
-				    PadnamePV(name)+1,PadnameLEN(name)-1,
-				     PadnameUTF8(name)
-				));
-		    if (PL_parser && PL_parser->copline != NOLINE)
-			CopLINE_set(PL_curcop, PL_parser->copline);
-		    report_redefined_cv(noamp, cv, &const_sv);
-		    CopLINE_set(PL_curcop, oldline);
-		}
-#ifdef PERL_MAD
-		if (!PL_minus_c)	/* keep old one around for madskills */
-#endif
-		    {
-			/* (PL_madskills unset in used file.) */
-			SvREFCNT_dec(cv);
-		    }
-		cv = NULL;
-	    }
 	}
 	else if (CvDEPTH(outcv) && CvCLONE(compcv)) {
 	    cv = NULL;
@@ -7097,7 +7186,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	op_free(block);
 	SvREFCNT_dec(compcv);
 	PL_compcv = NULL;
-	goto clone;
+	goto setname;
     }
     /* Checking whether outcv is CvOUTSIDE(compcv) is not sufficient to
        determine whether this sub definition is in the same scope as its
@@ -7160,6 +7249,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	cv = compcv;
 	*spot = cv;
     }
+   setname:
     if (!CvNAME_HEK(cv)) {
 	CvNAME_HEK_set(cv,
 	 hek
@@ -7169,6 +7259,8 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		      0)
 	);
     }
+    if (const_sv) goto clone;
+
     CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH_set(cv, PL_curstash);
 
@@ -7268,7 +7360,7 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    &PadARRAY(PadlistARRAY(CvPADLIST(outcv))[CvDEPTH(outcv)])[pax];
 	if (reusable) cv_clone_into(clonee, *spot);
 	else *spot = cv_clone(clonee);
-	SvREFCNT_dec(clonee);
+	SvREFCNT_dec_NN(clonee);
 	cv = *spot;
 	SvPADMY_on(cv);
     }
@@ -7370,20 +7462,20 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 
     if (ec) {
 	op_free(block);
-	SvREFCNT_dec(PL_compcv);
+	if (name) SvREFCNT_dec(PL_compcv);
+	else cv = PL_compcv;
 	PL_compcv = 0;
 	if (name && block) {
 	    const char *s = strrchr(name, ':');
 	    s = s ? s+1 : name;
 	    if (strEQ(s, "BEGIN")) {
-		const char not_safe[] =
-		    "BEGIN not safe after errors--compilation aborted";
 		if (PL_in_eval & EVAL_KEEPERR)
-		    Perl_croak(aTHX_ not_safe);
+		    Perl_croak_nocontext("BEGIN not safe after errors--compilation aborted");
 		else {
+                    SV * const errsv = ERRSV;
 		    /* force display of errors found but not reported */
-		    sv_catpv(ERRSV, not_safe);
-		    Perl_croak(aTHX_ "%"SVf, SVfARG(ERRSV));
+		    sv_catpvs(errsv, "BEGIN not safe after errors--compilation aborted");
+		    Perl_croak_nocontext("%"SVf, SVfARG(errsv));
 		}
 	    }
 	}
@@ -7432,48 +7524,14 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
             cv_ckproto_len_flags(cv, gv, ps, ps_len, ps_utf8);
 	/* already defined (or promised)? */
 	if (exists || GvASSUMECV(gv)) {
-	    if ((!block
-#ifdef PERL_MAD
-		 || block->op_type == OP_NULL
-#endif
-		 )) {
-		if (CvFLAGS(PL_compcv)) {
-		    /* might have had built-in attrs applied */
-		    const bool pureperl = !CvISXSUB(cv) && CvROOT(cv);
-		    if (CvLVALUE(PL_compcv) && ! CvLVALUE(cv) && pureperl
-		     && ckWARN(WARN_MISC))
-			Perl_warner(aTHX_ packWARN(WARN_MISC), "lvalue attribute ignored after the subroutine has been defined");
-		    CvFLAGS(cv) |=
-			(CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS
-			  & ~(CVf_LVALUE * pureperl));
-		}
+	    if (S_already_defined(aTHX_ cv, block, o, NULL, &const_sv))
+		cv = NULL;
+	    else {
 		if (attrs) goto attrs;
 		/* just a "sub foo;" when &foo is already defined */
 		SAVEFREESV(PL_compcv);
 		goto done;
 	    }
-	    if (block
-#ifdef PERL_MAD
-		&& block->op_type != OP_NULL
-#endif
-		) {
-		const line_t oldline = CopLINE(PL_curcop);
-		if (PL_parser && PL_parser->copline != NOLINE) {
-                        /* This ensures that warnings are reported at the first
-                           line of a redefinition, not the last.  */
-			CopLINE_set(PL_curcop, PL_parser->copline);
-                }
-		report_redefined_cv(cSVOPo->op_sv, cv, &const_sv);
-		CopLINE_set(PL_curcop, oldline);
-#ifdef PERL_MAD
-		if (!PL_minus_c)	/* keep old one around for madskills */
-#endif
-		    {
-			/* (PL_madskills unset in used file.) */
-			SvREFCNT_dec(cv);
-		    }
-		cv = NULL;
-	    }
 	}
     }
     if (const_sv) {
@@ -7557,7 +7615,7 @@ Perl_newATTRSUB_flags(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
 	    GvCVGEN(gv) = 0;
 	    if (HvENAME_HEK(GvSTASH(gv)))
 		/* sub Foo::bar { (shift)+1 } */
-		mro_method_changed_in(GvSTASH(gv));
+		gv_method_changed(gv);
 	}
     }
     if (!CvGV(cv)) {
@@ -7807,13 +7865,16 @@ Perl_newCONSTSUB_flags(pTHX_ HV *stash, const char *name, STRLEN len,
 	PL_curstash = (HV *)SvREFCNT_inc_simple_NN(stash);
     }
 
+    /* Protect sv against leakage caused by fatal warnings. */
+    if (sv) SAVEFREESV(sv);
+
     /* file becomes the CvFILE. For an XS, it's usually static storage,
        and so doesn't get free()d.  (It's expected to be from the C pre-
        processor __FILE__ directive). But we need a dynamically allocated one,
        and we need it to get freed.  */
     cv = newXS_len_flags(name, len, const_sv_xsub, file ? file : "", "",
 			 &sv, XS_DYNAMIC_FILENAME | flags);
-    CvXSUBANY(cv).any_ptr = sv;
+    CvXSUBANY(cv).any_ptr = SvREFCNT_inc_simple(sv);
     CvCONST_on(cv);
 
     LEAVE;
@@ -7868,7 +7929,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                                         ),
                                         cv, const_svp);
                 }
-                SvREFCNT_dec(cv);
+                SvREFCNT_dec_NN(cv);
                 cv = NULL;
             }
         }
@@ -7881,7 +7942,7 @@ Perl_newXS_len_flags(pTHX_ const char *name, STRLEN len,
                 GvCV_set(gv,cv);
                 GvCVGEN(gv) = 0;
                 if (HvENAME_HEK(GvSTASH(gv)))
-                    mro_method_changed_in(GvSTASH(gv)); /* newXS */
+                    gv_method_changed(gv); /* newXS */
             }
         }
         if (!name)
@@ -7915,7 +7976,7 @@ Perl_newSTUB(pTHX_ GV *gv, bool fake)
     GvCV_set(gv, cv);
     GvCVGEN(gv) = 0;
     if (!fake && HvENAME_HEK(GvSTASH(gv)))
-	mro_method_changed_in(GvSTASH(gv));
+	gv_method_changed(gv);
     CvGV_set(cv, gv);
     CvFILE_set_from_cop(cv, PL_curcop);
     CvSTASH_set(cv, PL_curstash);
@@ -8147,7 +8208,6 @@ Perl_newCVREF(pTHX_ I32 flags, OP *o)
 	dVAR;
 	o->op_type = OP_PADCV;
 	o->op_ppaddr = PL_ppaddr[OP_PADCV];
-	return o;
     }
     return newUNOP(OP_RV2CV, flags, scalar(o));
 }
@@ -8175,9 +8235,6 @@ Perl_ck_anoncode(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_ANONCODE;
 
-    /* After errors, we won’t have any sub. */
-    if (!cSVOPo->op_sv) return o;
-
     cSVOPo->op_targ = pad_add_anon((CV*)cSVOPo->op_sv, o->op_type);
     if (!PL_madskills)
 	cSVOPo->op_sv = NULL;
@@ -8284,6 +8341,8 @@ Perl_ck_spair(pTHX_ OP *o)
 #endif
 	kUNOP->op_first = newop;
     }
+    /* transforms OP_REFGEN into OP_SREFGEN, OP_CHOP into OP_SCHOP,
+     * and OP_CHOMP into OP_SCHOMP */
     o->op_ppaddr = PL_ppaddr[++o->op_type];
     return ck_fun(o);
 }
@@ -8493,7 +8552,7 @@ Perl_ck_exists(pTHX_ OP *o)
 }
 
 OP *
-Perl_ck_rvconst(pTHX_ register OP *o)
+Perl_ck_rvconst(pTHX_ OP *o)
 {
     dVAR;
     SVOP * const kid = (SVOP*)cUNOPo->op_first;
@@ -8585,6 +8644,7 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 	    SvREFCNT_dec(kid->op_sv);
 #ifdef USE_ITHREADS
 	    /* XXX hack: dependence on sizeof(PADOP) <= sizeof(SVOP) */
+	    assert (sizeof(PADOP) <= sizeof(SVOP));
 	    kPADOP->op_padix = pad_alloc(OP_GV, SVs_PADTMP);
 	    SvREFCNT_dec(PAD_SVl(kPADOP->op_padix));
 	    GvIN_PAD_on(gv);
@@ -8996,12 +9056,10 @@ Perl_ck_glob(pTHX_ OP *o)
 	 *                 \ mark - glob - rv2cv
 	 *                             |        \ gv(CORE::GLOBAL::glob)
 	 *                             |
-	 *                              \ null - const(wildcard) - const(ix)
+	 *                              \ null - const(wildcard)
 	 */
 	o->op_flags |= OPf_SPECIAL;
 	o->op_targ = pad_alloc(OP_GLOB, SVs_PADTMP);
-	op_append_elem(OP_GLOB, o,
-		    newSVOP(OP_CONST, 0, newSViv(PL_glob_index++)));
 	o = newLISTOP(OP_LIST, 0, o, NULL);
 	o = newUNOP(OP_ENTERSUB, OPf_STACKED,
 		    op_append_elem(OP_LIST, o,
@@ -9023,11 +9081,8 @@ Perl_ck_glob(pTHX_ OP *o)
     gv = (GV *)newSV(0);
     gv_init(gv, 0, "", 0, 0);
     gv_IOadd(gv);
-#ifndef PERL_EXTERNAL_GLOB
-    sv_setiv(GvSVn(gv),PL_glob_index++);
-#endif
     op_append_elem(OP_GLOB, o, newGVOP(OP_GV, 0, gv));
-    SvREFCNT_dec(gv); /* newGVOP increased it */
+    SvREFCNT_dec_NN(gv); /* newGVOP increased it */
     scalarkids(o);
     return o;
 }
@@ -9099,9 +9154,19 @@ Perl_ck_index(pTHX_ OP *o)
 	if (kid)
 	    kid = kid->op_sibling;			/* get past "big" */
 	if (kid && kid->op_type == OP_CONST) {
-	    const bool save_taint = TAINT_get; /* accepted unused var warning if NO_TAINT_SUPPORT */
-	    fbm_compile(((SVOP*)kid)->op_sv, 0);
+	    const bool save_taint = TAINT_get;
+	    SV *sv = kSVOP->op_sv;
+	    if ((!SvPOK(sv) || SvNIOKp(sv)) && SvOK(sv) && !SvROK(sv)) {
+		sv = newSV(0);
+		sv_copypv(sv, kSVOP->op_sv);
+		SvREFCNT_dec_NN(kSVOP->op_sv);
+		kSVOP->op_sv = sv;
+	    }
+	    if (SvOK(sv)) fbm_compile(sv, 0);
 	    TAINT_set(save_taint);
+#ifdef NO_TAINT_SUPPORT
+            PERL_UNUSED_VAR(save_taint);
+#endif
 	}
     }
     return ck_fun(o);
@@ -9344,7 +9409,7 @@ Perl_ck_method(pTHX_ OP *o)
 	const char * const method = SvPVX_const(sv);
 	if (!(strchr(method, ':') || strchr(method, '\''))) {
 	    OP *cmop;
-	    if (!SvREADONLY(sv) || !SvFAKE(sv)) {
+	    if (!SvIsCOW(sv)) {
 		sv = newSVpvn_share(method, SvUTF8(sv) ? -(I32)SvCUR(sv) : (I32)SvCUR(sv), 0);
 	    }
 	    else {
@@ -9469,14 +9534,9 @@ Perl_ck_require(pTHX_ OP *o)
 	    const char *end;
 
 	    if (was_readonly) {
-		if (SvFAKE(sv)) {
-		    sv_force_normal_flags(sv, 0);
-		    assert(!SvREADONLY(sv));
-		    was_readonly = 0;
-		} else {
 		    SvREADONLY_off(sv);
-		}
 	    }   
+	    if (SvIsCOW(sv)) sv_force_normal_flags(sv, 0);
 
 	    s = SvPVX(sv);
 	    len = SvCUR(sv);
@@ -9605,7 +9665,10 @@ Perl_ck_sort(pTHX_ OP *o)
 {
     dVAR;
     OP *firstkid;
-    HV * const hinthv = GvHV(PL_hintgv);
+    OP *kid;
+    HV * const hinthv =
+	PL_hints & HINT_LOCALIZE_HH ? GvHV(PL_hintgv) : NULL;
+    U8 stacked;
 
     PERL_ARGS_ASSERT_CK_SORT;
 
@@ -9623,7 +9686,7 @@ Perl_ck_sort(pTHX_ OP *o)
     if (o->op_flags & OPf_STACKED)
 	simplify_sort(o);
     firstkid = cLISTOPo->op_first->op_sibling;		/* get past pushmark */
-    if (o->op_flags & OPf_STACKED) {			/* may have been cleared */
+    if ((stacked = o->op_flags & OPf_STACKED)) {	/* may have been cleared */
 	OP *kid = cUNOPx(firstkid)->op_first;		/* get past null */
 
 	if (kid->op_type == OP_SCOPE || kid->op_type == OP_LEAVE) {
@@ -9642,8 +9705,12 @@ Perl_ck_sort(pTHX_ OP *o)
 	firstkid = firstkid->op_sibling;
     }
 
-    /* provide list context for arguments */
-    list(firstkid);
+    for (kid = firstkid; kid; kid = kid->op_sibling) {
+	/* provide list context for arguments */
+	list(kid);
+	if (stacked)
+	    op_lvalue(kid, OP_GREPSTART);
+    }
 
     return o;
 }
@@ -9661,8 +9728,6 @@ S_simplify_sort(pTHX_ OP *o)
 
     PERL_ARGS_ASSERT_SIMPLIFY_SORT;
 
-    if (!(o->op_flags & OPf_STACKED))
-	return;
     GvMULTI_on(gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV));
     GvMULTI_on(gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV));
     kid = kUNOP->op_first;				/* get past null */
@@ -9778,15 +9843,10 @@ Perl_ck_split(pTHX_ OP *o)
 	cLISTOPo->op_last = kid; /* There was only one element previously */
     }
 
-    if (kid->op_type == OP_CONST && !(kid->op_private & OPpCONST_FOLDED)) {
-	SV * const sv = kSVOP->op_sv;
-	if (SvPOK(sv) && SvCUR(sv) == 1 && *SvPVX(sv) == ' ')
-	    o->op_flags |= OPf_SPECIAL;
-    }
     if (kid->op_type != OP_MATCH || kid->op_flags & OPf_STACKED) {
 	OP * const sibl = kid->op_sibling;
 	kid->op_sibling = 0;
-	kid = pmruntime( newPMOP(OP_MATCH, 0), kid, 0, 0);
+        kid = pmruntime( newPMOP(OP_MATCH, OPf_SPECIAL), kid, 0, 0); /* OPf_SPECIAL is used to trigger split " " behavior */
 	if (cLISTOPo->op_first == cLISTOPo->op_last)
 	    cLISTOPo->op_last = kid;
 	cLISTOPo->op_first = kid;
@@ -9808,7 +9868,10 @@ Perl_ck_split(pTHX_ OP *o)
     scalar(kid);
 
     if (!kid->op_sibling)
+    {
 	op_append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
+	o->op_private |= OPpSPLIT_IMPLIM;
+    }
     assert(kid->op_sibling);
 
     kid = kid->op_sibling;
@@ -9881,6 +9944,28 @@ subroutine.
 =cut
 */
 
+/* shared by toke.c:yylex */
+CV *
+Perl_find_lexical_cv(pTHX_ PADOFFSET off)
+{
+    PADNAME *name = PAD_COMPNAME(off);
+    CV *compcv = PL_compcv;
+    while (PadnameOUTER(name)) {
+	assert(PARENT_PAD_INDEX(name));
+	compcv = CvOUTSIDE(PL_compcv);
+	name = PadlistNAMESARRAY(CvPADLIST(compcv))
+		[off = PARENT_PAD_INDEX(name)];
+    }
+    assert(!PadnameIsOUR(name));
+    if (!PadnameIsSTATE(name) && SvMAGICAL(name)) {
+	MAGIC * mg = mg_find(name, PERL_MAGIC_proto);
+	assert(mg);
+	assert(mg->mg_obj);
+	return (CV *)mg->mg_obj;
+    }
+    return (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off];
+}
+
 CV *
 Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags)
 {
@@ -9915,24 +10000,7 @@ Perl_rv2cv_op_cv(pTHX_ OP *cvop, U32 flags)
 	    gv = NULL;
 	} break;
 	case OP_PADCV: {
-	    PADNAME *name = PAD_COMPNAME(rvop->op_targ);
-	    CV *compcv = PL_compcv;
-	    PADOFFSET off = rvop->op_targ;
-	    while (PadnameOUTER(name)) {
-		assert(PARENT_PAD_INDEX(name));
-		compcv = CvOUTSIDE(PL_compcv);
-		name = PadlistNAMESARRAY(CvPADLIST(compcv))
-			[off = PARENT_PAD_INDEX(name)];
-	    }
-	    assert(!PadnameIsOUR(name));
-	    if (!PadnameIsSTATE(name)) {
-		MAGIC * mg = mg_find(name, PERL_MAGIC_proto);
-		assert(mg);
-		assert(mg->mg_obj);
-		cv = (CV *)mg->mg_obj;
-	    }
-	    else cv =
-		    (CV *)AvARRAY(PadlistARRAY(CvPADLIST(compcv))[1])[off];
+	    cv = find_lexical_cv(rvop->op_targ);
 	    gv = NULL;
 	} break;
 	default: {
@@ -10025,6 +10093,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
     if (SvTYPE(protosv) == SVt_PVCV)
 	 proto = CvPROTO(protosv), proto_len = CvPROTOLEN(protosv);
     else proto = SvPV(protosv, proto_len);
+    proto = S_strip_spaces(aTHX_ proto, &proto_len);
     proto_end = proto + proto_len;
     aop = cUNOPx(entersubop)->op_first;
     if (!aop->op_sibling)
@@ -10069,9 +10138,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 		proto++;
 		arg++;
 		if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
-		    bad_type_sv(arg,
+		    bad_type_gv(arg,
 			    arg == 1 ? "block or sub {}" : "sub {}",
-			    gv_ename(namegv), 0, o3);
+			    namegv, 0, o3);
 		break;
 	    case '*':
 		/* '*' allows any scalar type, including bareword */
@@ -10156,9 +10225,9 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				     OP_READ, /* not entersub */
 				     OP_LVALUE_NO_CROAK
 				    )) goto wrapref;
-			    bad_type_sv(arg, Perl_form(aTHX_ "one of %.*s",
+			    bad_type_gv(arg, Perl_form(aTHX_ "one of %.*s",
 					(int)(end - p), p),
-				    gv_ename(namegv), 0, o3);
+				    namegv, 0, o3);
 			} else
 			    goto oops;
 			break;
@@ -10166,13 +10235,13 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 			if (o3->op_type == OP_RV2GV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "symbol", gv_ename(namegv), 0, o3);
+			    bad_type_gv(arg, "symbol", namegv, 0, o3);
 			break;
 		    case '&':
 			if (o3->op_type == OP_ENTERSUB)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "subroutine entry", gv_ename(namegv), 0,
+			    bad_type_gv(arg, "subroutine entry", namegv, 0,
 				    o3);
 			break;
 		    case '$':
@@ -10188,7 +10257,7 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				    OP_READ,  /* not entersub */
 				    OP_LVALUE_NO_CROAK
 			       )) goto wrapref;
-			    bad_type_sv(arg, "scalar", gv_ename(namegv), 0, o3);
+			    bad_type_gv(arg, "scalar", namegv, 0, o3);
 			}
 			break;
 		    case '@':
@@ -10196,14 +10265,14 @@ Perl_ck_entersub_args_proto(pTHX_ OP *entersubop, GV *namegv, SV *protosv)
 				o3->op_type == OP_PADAV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "array", gv_ename(namegv), 0, o3);
+			    bad_type_gv(arg, "array", namegv, 0, o3);
 			break;
 		    case '%':
 			if (o3->op_type == OP_RV2HV ||
 				o3->op_type == OP_PADHV)
 			    goto wrapref;
 			if (!contextclass)
-			    bad_type_sv(arg, "hash", gv_ename(namegv), 0, o3);
+			    bad_type_gv(arg, "hash", namegv, 0, o3);
 			break;
 		    wrapref:
 			{
@@ -10529,7 +10598,9 @@ Perl_ck_subr(pTHX_ OP *o)
 		   really need is a new call checker API that accepts a
 		   GV or string (or GV or CV). */
 	    HEK * const hek = CvNAME_HEK(cv);
-	    assert(hek);
+	    /* After a syntax error in a lexical sub, the cv that
+	       rv2cv_op_cv returns may be a nameless stub. */
+	    if (!hek) return ck_entersub_args_list(o);;
 	    namegv = (GV *)sv_newmortal();
 	    gv_init_pvn(namegv, PL_curstash, HEK_KEY(hek), HEK_LEN(hek),
 			SVf_UTF8 * !!HEK_UTF8(hek));
@@ -10543,7 +10614,7 @@ Perl_ck_svconst(pTHX_ OP *o)
 {
     PERL_ARGS_ASSERT_CK_SVCONST;
     PERL_UNUSED_CONTEXT;
-    SvREADONLY_on(cSVOPo->op_sv);
+    if (!SvIsCOW(cSVOPo->op_sv)) SvREADONLY_on(cSVOPo->op_sv);
     return o;
 }
 
@@ -10679,9 +10750,11 @@ Perl_ck_length(pTHX_ OP *o)
                     name, hash ? "keys " : "", name
                 );
             else if (hash)
+     /* diag_listed_as: length() used on %s (did you mean "scalar(%s)"?) */
                 Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                     "length() used on %%hash (did you mean \"scalar(keys %%hash)\"?)");
             else
+     /* diag_listed_as: length() used on %s (did you mean "scalar(%s)"?) */
                 Perl_warner(aTHX_ packWARN(WARN_SYNTAX),
                     "length() used on @array (did you mean \"scalar(@array)\"?)");
         }
@@ -10790,7 +10863,7 @@ S_inplace_aassign(pTHX_ OP *o) {
  * peep() is called */
 
 void
-Perl_rpeep(pTHX_ register OP *o)
+Perl_rpeep(pTHX_ OP *o)
 {
     dVAR;
     OP* oldop = NULL;
@@ -11523,7 +11596,7 @@ Perl_rpeep(pTHX_ register OP *o)
 }
 
 void
-Perl_peep(pTHX_ register OP *o)
+Perl_peep(pTHX_ OP *o)
 {
     CALL_RPEEP(o);
 }
@@ -11906,14 +11979,7 @@ const_sv_xsub(pTHX_ CV* cv)
     dVAR;
     dXSARGS;
     SV *const sv = MUTABLE_SV(XSANY.any_ptr);
-    if (items != 0) {
-	NOOP;
-#if 0
-	/* diag_listed_as: SKIPME */
-        Perl_croak(aTHX_ "usage: %s::%s()",
-                   HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));
-#endif
-    }
+    PERL_UNUSED_ARG(items);
     if (!sv) {
 	XSRETURN(0);
     }