X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/4136a0f799bd94dcf9c5197e35db53e3c3c012b5..e28bb1d52bee845e0aab3d253cd27698a545c674:/op.c

diff --git a/op.c b/op.c
index f1a1c1b..a74743e 100644
--- a/op.c
+++ b/op.c
@@ -186,7 +186,6 @@ Perl_pending_Slabs_to_ro(pTHX) {
        read only. Also, do it ahead of the loop in case the warn triggers,
        and a warn handler has an eval */
 
-    free(PL_slabs);
     PL_slabs = NULL;
     PL_slab_count = 0;
 
@@ -194,13 +193,15 @@ Perl_pending_Slabs_to_ro(pTHX) {
     PL_OpSpace = 0;
 
     while (count--) {
-	const void *start = slabs[count];
+	void *const start = slabs[count];
 	const size_t size = PERL_SLAB_SIZE* sizeof(I32*);
 	if(mprotect(start, size, PROT_READ)) {
 	    Perl_warn(aTHX_ "mprotect for %p %lu failed with %d",
 		      start, (unsigned long) size, errno);
 	}
     }
+
+    free(slabs);
 }
 
 STATIC void
@@ -216,6 +217,24 @@ S_Slab_to_rw(pTHX_ void *op)
 		  slab, (unsigned long) PERL_SLAB_SIZE*sizeof(I32*), errno);
     }
 }
+
+OP *
+Perl_op_refcnt_inc(pTHX_ OP *o)
+{
+    if(o) {
+	Slab_to_rw(o);
+	++o->op_targ;
+    }
+    return o;
+
+}
+
+PADOFFSET
+Perl_op_refcnt_dec(pTHX_ OP *o)
+{
+    Slab_to_rw(o);
+    return --o->op_targ;
+}
 #else
 #  define Slab_to_rw(op)
 #endif
@@ -249,17 +268,12 @@ Perl_Slab_Free(pTHX_ void *op)
 		    PL_slabs[count] = PL_slabs[--PL_slab_count];
 		    /* Could realloc smaller at this point, but probably not
 		       worth it.  */
-		    goto gotcha;
+		    if(munmap(slab, PERL_SLAB_SIZE*sizeof(I32*))) {
+			perror("munmap failed");
+			abort();
+		    }
+		    break;
 		}
-		
-	    }
-	    Perl_croak(aTHX_
-		       "panic: Couldn't find slab at %p (%lu allocated)",
-		       slab, (unsigned long) PL_slabs);
-	gotcha:
-	    if(munmap(slab, PERL_SLAB_SIZE*sizeof(I32*))) {
-		perror("munmap failed");
-		abort();
 	    }
 	}
 #else
@@ -338,7 +352,7 @@ Perl_allocmy(pTHX_ const char *const name)
 {
     dVAR;
     PADOFFSET off;
-    const bool is_our = (PL_in_my == KEY_our);
+    const bool is_our = (PL_parser->in_my == KEY_our);
 
     /* complain about "my $<special_var>" etc etc */
     if (*name &&
@@ -349,35 +363,44 @@ Perl_allocmy(pTHX_ const char *const name)
     {
 	/* name[2] is true if strlen(name) > 2  */
 	if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
-	    yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"my\"",
-			      name[0], toCTRL(name[1]), name + 2));
+	    yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"%s\"",
+			      name[0], toCTRL(name[1]), name + 2,
+			      PL_parser->in_my == KEY_state ? "state" : "my"));
 	} else {
-	    yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
+	    yyerror(Perl_form(aTHX_ "Can't use global %s in \"%s\"",name,
+			      PL_parser->in_my == KEY_state ? "state" : "my"));
 	}
     }
 
     /* check for duplicate declaration */
     pad_check_dup(name, is_our, (PL_curstash ? PL_curstash : PL_defstash));
 
-    if (PL_in_my_stash && *name != '$') {
+    if (PL_parser->in_my_stash && *name != '$') {
 	yyerror(Perl_form(aTHX_
 		    "Can't declare class for non-scalar %s in \"%s\"",
  		     name,
- 		     is_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
+ 		     is_our ? "our"
+			    : PL_parser->in_my == KEY_state ? "state" : "my"));
     }
 
     /* allocate a spare slot and store the name in that slot */
 
     off = pad_add_name(name,
-		    PL_in_my_stash,
+		    PL_parser->in_my_stash,
 		    (is_our
 		        /* $_ is always in main::, even with our */
 			? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
 			: NULL
 		    ),
 		    0, /*  not fake */
-		    PL_in_my == KEY_state
+		    PL_parser->in_my == KEY_state
     );
+    /* anon sub prototypes contains state vars should always be cloned,
+     * otherwise the state var would be shared between anon subs */
+
+    if (PL_parser->in_my == KEY_state && CvANON(PL_compcv))
+	CvCLONE_on(PL_compcv);
+
     return off;
 }
 
@@ -394,6 +417,11 @@ 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 */
 
@@ -403,7 +431,7 @@ Perl_op_free(pTHX_ OP *o)
     dVAR;
     OPCODE type;
 
-    if (!o || o->op_static)
+    if (!o)
 	return;
     if (o->op_latefreed) {
 	if (o->op_latefree)
@@ -422,15 +450,16 @@ Perl_op_free(pTHX_ OP *o)
 	case OP_LEAVEWRITE:
 	    {
 	    PADOFFSET refcnt;
-#ifdef PERL_DEBUG_READONLY_OPS
-	    Slab_to_rw(o);
-#endif
 	    OP_REFCNT_LOCK;
 	    refcnt = OpREFCNT_dec(o);
 	    OP_REFCNT_UNLOCK;
-	    if (refcnt)
+	    if (refcnt) {
+		/* Need to find and remove any pattern match ops from the list
+		   we maintain for reset().  */
+		find_and_forget_pmops(o);
 		return;
 	    }
+	    }
 	    break;
 	default:
 	    break;
@@ -447,12 +476,13 @@ Perl_op_free(pTHX_ OP *o)
     if (type == OP_NULL)
 	type = (OPCODE)o->op_targ;
 
+#ifdef PERL_DEBUG_READONLY_OPS
+    Slab_to_rw(o);
+#endif
+
     /* COP* is not cleared by op_clear() so that we may track line
      * numbers etc even after null() */
     if (type == OP_NEXTSTATE || type == OP_SETSTATE || type == OP_DBSTATE) {
-#ifdef PERL_DEBUG_READONLY_OPS
-	Slab_to_rw(o);
-#endif
 	cop_free((COP*)o);
     }
 
@@ -565,45 +595,24 @@ Perl_op_clear(pTHX_ OP *o)
 	}
 	break;
     case OP_SUBST:
-	op_free(cPMOPo->op_pmreplroot);
+	op_free(cPMOPo->op_pmreplrootu.op_pmreplroot);
 	goto clear_pmop;
     case OP_PUSHRE:
 #ifdef USE_ITHREADS
-        if (INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot)) {
+        if (cPMOPo->op_pmreplrootu.op_pmtargetoff) {
 	    /* No GvIN_PAD_off here, because other references may still
 	     * exist on the pad */
-	    pad_swipe(INT2PTR(PADOFFSET, cPMOPo->op_pmreplroot), TRUE);
+	    pad_swipe(cPMOPo->op_pmreplrootu.op_pmtargetoff, TRUE);
 	}
 #else
-	SvREFCNT_dec((SV*)cPMOPo->op_pmreplroot);
+	SvREFCNT_dec((SV*)cPMOPo->op_pmreplrootu.op_pmtargetgv);
 #endif
 	/* FALL THROUGH */
     case OP_MATCH:
     case OP_QR:
 clear_pmop:
-	{
-	    HV * const pmstash = PmopSTASH(cPMOPo);
-	    if (pmstash && !SvIS_FREED(pmstash)) {
-		MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
-		if (mg) {
-		    PMOP *pmop = (PMOP*) mg->mg_obj;
-		    PMOP *lastpmop = NULL;
-		    while (pmop) {
-			if (cPMOPo == pmop) {
-			    if (lastpmop)
-				lastpmop->op_pmnext = pmop->op_pmnext;
-			    else
-				mg->mg_obj = (SV*) pmop->op_pmnext;
-			    break;
-			}
-			lastpmop = pmop;
-			pmop = pmop->op_pmnext;
-		    }
-		}
-	    }
-	    PmopSTASH_free(cPMOPo);
-	}
-	cPMOPo->op_pmreplroot = NULL;
+	forget_pmop(cPMOPo, 1);
+	cPMOPo->op_pmreplrootu.op_pmreplroot = NULL;
         /* we use the "SAFE" version of the PM_ macros here
          * since sv_clean_all might release some PMOPs
          * after PL_regex_padav has been cleared
@@ -641,6 +650,65 @@ S_cop_free(pTHX_ COP* cop)
     Perl_refcounted_he_free(aTHX_ cop->cop_hints_hash);
 }
 
+STATIC void
+S_forget_pmop(pTHX_ PMOP *const o
+#ifdef USE_ITHREADS
+	      , U32 flags
+#endif
+	      )
+{
+    HV * const pmstash = PmopSTASH(o);
+    if (pmstash && !SvIS_FREED(pmstash)) {
+	MAGIC * const mg = mg_find((SV*)pmstash, PERL_MAGIC_symtab);
+	if (mg) {
+	    PMOP **const array = (PMOP**) mg->mg_ptr;
+	    U32 count = mg->mg_len / sizeof(PMOP**);
+	    U32 i = count;
+
+	    while (i--) {
+		if (array[i] == o) {
+		    /* Found it. Move the entry at the end to overwrite it.  */
+		    array[i] = array[--count];
+		    mg->mg_len = count * sizeof(PMOP**);
+		    /* Could realloc smaller at this point always, but probably
+		       not worth it. Probably worth free()ing if we're the
+		       last.  */
+		    if(!count) {
+			Safefree(mg->mg_ptr);
+			mg->mg_ptr = NULL;
+		    }
+		    break;
+		}
+	    }
+	}
+    }
+    if (PL_curpm == o) 
+	PL_curpm = NULL;
+#ifdef USE_ITHREADS
+    if (flags)
+	PmopSTASH_free(o);
+#endif
+}
+
+STATIC void
+S_find_and_forget_pmops(pTHX_ OP *o)
+{
+    if (o->op_flags & OPf_KIDS) {
+        OP *kid = cUNOPo->op_first;
+	while (kid) {
+	    switch (kid->op_type) {
+	    case OP_SUBST:
+	    case OP_PUSHRE:
+	    case OP_MATCH:
+	    case OP_QR:
+		forget_pmop((PMOP*)kid, 0);
+	    }
+	    find_and_forget_pmops(kid);
+	    kid = kid->op_sibling;
+	}
+    }
+}
+
 void
 Perl_op_null(pTHX_ OP *o)
 {
@@ -723,8 +791,8 @@ S_scalarboolean(pTHX_ OP *o)
 	if (ckWARN(WARN_SYNTAX)) {
 	    const line_t oldline = CopLINE(PL_curcop);
 
-	    if (PL_copline != NOLINE)
-		CopLINE_set(PL_curcop, PL_copline);
+	    if (PL_parser && PL_parser->copline != NOLINE)
+		CopLINE_set(PL_curcop, PL_parser->copline);
 	    Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Found = in conditional, should be ==");
 	    CopLINE_set(PL_curcop, oldline);
 	}
@@ -739,7 +807,8 @@ Perl_scalar(pTHX_ OP *o)
     OP *kid;
 
     /* assumes no premature commitment */
-    if (!o || PL_error_count || (o->op_flags & OPf_WANT)
+    if (!o || (PL_parser && PL_parser->error_count)
+	 || (o->op_flags & OPf_WANT)
 	 || o->op_type == OP_RETURN)
     {
 	return o;
@@ -759,7 +828,7 @@ Perl_scalar(pTHX_ OP *o)
 	break;
     case OP_SPLIT:
 	if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
-	    if (!kPMOP->op_pmreplroot)
+	    if (!kPMOP->op_pmreplrootu.op_pmreplroot)
 		deprecate_old("implicit split to @_");
 	}
 	/* FALL THROUGH */
@@ -837,7 +906,8 @@ Perl_scalarvoid(pTHX_ OP *o)
 
     /* assumes no premature commitment */
     want = o->op_flags & OPf_WANT;
-    if ((want && want != OPf_WANT_SCALAR) || PL_error_count
+    if ((want && want != OPf_WANT_SCALAR)
+	 || (PL_parser && PL_parser->error_count)
 	 || o->op_type == OP_RETURN)
     {
 	return o;
@@ -1054,7 +1124,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 	return scalar(o);
     case OP_SPLIT:
 	if ((kid = cLISTOPo->op_first) && kid->op_type == OP_PUSHRE) {
-	    if (!kPMOP->op_pmreplroot)
+	    if (!kPMOP->op_pmreplrootu.op_pmreplroot)
 		deprecate_old("implicit split to @_");
 	}
 	break;
@@ -1082,7 +1152,8 @@ Perl_list(pTHX_ OP *o)
     OP *kid;
 
     /* assumes no premature commitment */
-    if (!o || (o->op_flags & OPf_WANT) || PL_error_count
+    if (!o || (o->op_flags & OPf_WANT)
+	 || (PL_parser && PL_parser->error_count)
 	 || o->op_type == OP_RETURN)
     {
 	return o;
@@ -1208,7 +1279,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
     /* -1 = error on localize, 0 = ignore localize, 1 = ok to localize */
     int localize = -1;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
 	return o;
 
     if ((o->op_private & OPpTARGET_MY)
@@ -1241,7 +1312,7 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	    Perl_croak(aTHX_ "That use of $[ is unsupported");
 	break;
     case OP_STUB:
-	if (o->op_flags & OPf_PARENS || PL_madskills)
+	if ((o->op_flags & OPf_PARENS) || PL_madskills)
 	    break;
 	goto nomod;
     case OP_ENTERSUB:
@@ -1590,6 +1661,7 @@ S_scalar_mod_type(const OP *o, I32 type)
     case OP_RECV:
     case OP_ANDASSIGN:
     case OP_ORASSIGN:
+    case OP_DORASSIGN:
 	return TRUE;
     default:
 	return FALSE;
@@ -1636,7 +1708,7 @@ Perl_doref(pTHX_ OP *o, I32 type, bool set_op_ref)
     dVAR;
     OP *kid;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
 	return o;
 
     switch (o->op_type) {
@@ -1758,7 +1830,6 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 
     /* fake up C<use attributes $pkg,$rv,@attrs> */
     ENTER;		/* need to protect against side-effects of 'use' */
-    SAVEINT(PL_expect);
     stashsv = stash ? newSVhek(HvNAME_HEK(stash)) : &PL_sv_no;
 
 #define ATTRSMODULE "attributes"
@@ -1885,7 +1956,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     dVAR;
     I32 type;
 
-    if (!o || PL_error_count)
+    if (!o || (PL_parser && PL_parser->error_count))
 	return o;
 
     type = o->op_type;
@@ -1910,11 +1981,13 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
 	if (cUNOPo->op_first->op_type != OP_GV) { /* MJD 20011224 */
 	    yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
 			OP_DESC(o),
-			PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
+			PL_parser->in_my == KEY_our
+			    ? "our"
+			    : PL_parser->in_my == KEY_state ? "state" : "my"));
 	} else if (attrs) {
 	    GV * const gv = cGVOPx_gv(cUNOPo->op_first);
-	    PL_in_my = FALSE;
-	    PL_in_my_stash = NULL;
+	    PL_parser->in_my = FALSE;
+	    PL_parser->in_my_stash = NULL;
 	    apply_attrs(GvSTASH(gv),
 			(type == OP_RV2SV ? GvSV(gv) :
 			 type == OP_RV2AV ? (SV*)GvAV(gv) :
@@ -1931,14 +2004,16 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     {
 	yyerror(Perl_form(aTHX_ "Can't declare %s in \"%s\"",
 			  OP_DESC(o),
-			  PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
+			  PL_parser->in_my == KEY_our
+			    ? "our"
+			    : PL_parser->in_my == KEY_state ? "state" : "my"));
 	return o;
     }
     else if (attrs && type != OP_PUSHMARK) {
 	HV *stash;
 
-	PL_in_my = FALSE;
-	PL_in_my_stash = NULL;
+	PL_parser->in_my = FALSE;
+	PL_parser->in_my_stash = NULL;
 
 	/* check for C<my Dog $spot> when deciding package */
 	stash = PAD_COMPNAME_TYPE(o->op_targ);
@@ -1948,7 +2023,7 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
     }
     o->op_flags |= OPf_MOD;
     o->op_private |= OPpLVAL_INTRO;
-    if (PL_in_my == KEY_state)
+    if (PL_parser->in_my == KEY_state)
 	o->op_private |= OPpPAD_STATE;
     return o;
 }
@@ -1982,8 +2057,8 @@ Perl_my_attrs(pTHX_ OP *o, OP *attrs)
 	else
 	    o = append_list(OP_LIST, (LISTOP*)o, (LISTOP*)rops);
     }
-    PL_in_my = FALSE;
-    PL_in_my_stash = NULL;
+    PL_parser->in_my = FALSE;
+    PL_parser->in_my_stash = NULL;
     return o;
 }
 
@@ -2201,10 +2276,11 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 	NOOP;
 #endif
     else {
-	if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
+	if ( PL_parser->bufptr > PL_parser->oldbufptr
+	    && PL_parser->bufptr[-1] == ','
 	    && ckWARN(WARN_PARENTHESIS))
 	{
-	    char *s = PL_bufptr;
+	    char *s = PL_parser->bufptr;
 	    bool sigil = FALSE;
 
 	    /* some heuristics to detect a potential error */
@@ -2227,8 +2303,13 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 	    if (sigil && (*s == ';' || *s == '=')) {
 		Perl_warner(aTHX_ packWARN(WARN_PARENTHESIS),
 				"Parentheses missing around \"%s\" list",
-				lex ? (PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")
-				: "local");
+				lex
+				    ? (PL_parser->in_my == KEY_our
+					? "our"
+					: PL_parser->in_my == KEY_state
+					    ? "state"
+					    : "my")
+				    : "local");
 	    }
 	}
     }
@@ -2236,8 +2317,8 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 	o = my(o);
     else
 	o = mod(o, OP_NULL);		/* a bit kludgey */
-    PL_in_my = FALSE;
-    PL_in_my_stash = NULL;
+    PL_parser->in_my = FALSE;
+    PL_parser->in_my_stash = NULL;
     return o;
 }
 
@@ -2303,7 +2384,7 @@ Perl_fold_constants(pTHX_ register OP *o)
 	    goto nope;
     }
 
-    if (PL_error_count)
+    if (PL_parser && PL_parser->error_count)
 	goto nope;		/* Don't try to run w/ errors */
 
     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
@@ -2389,7 +2470,7 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     const I32 oldtmps_floor = PL_tmps_floor;
 
     list(o);
-    if (PL_error_count)
+    if (PL_parser && PL_parser->error_count)
 	return o;		/* Don't attempt to run with errors */
 
     PL_op = curop = LINKLIST(o);
@@ -2737,7 +2818,7 @@ Perl_newMADsv(pTHX_ char key, SV* sv)
 }
 
 MADPROP *
-Perl_newMADPROP(pTHX_ char key, char type, void* val, I32 vlen)
+Perl_newMADPROP(pTHX_ char key, char type, const void* val, I32 vlen)
 {
     MADPROP *mp;
     Newxz(mp, 1, MADPROP);
@@ -2758,7 +2839,7 @@ Perl_mad_free(pTHX_ MADPROP* mp)
 	return;
     if (mp->mad_next)
 	mad_free(mp->mad_next);
-/*    if (PL_lex_state != LEX_NOTPARSING && mp->mad_vlen)
+/*    if (PL_parser && PL_parser->lex_state != LEX_NOTPARSING && mp->mad_vlen)
 	PerlIO_printf(PerlIO_stderr(), "DESTROYING '%c'=<%s>\n", mp->mad_key & 255, mp->mad_val); */
     switch (mp->mad_type) {
     case MAD_NULL:
@@ -3292,18 +3373,6 @@ Perl_newPMOP(pTHX_ I32 type, I32 flags)
     }
 #endif
 
-        /* link into pm list */
-    if (type != OP_TRANS && PL_curstash) {
-	MAGIC *mg = mg_find((SV*)PL_curstash, PERL_MAGIC_symtab);
-
-	if (!mg) {
-	    mg = sv_magicext((SV*)PL_curstash, 0, PERL_MAGIC_symtab, 0, 0, 0);
-	}
-	pmop->op_pmnext = (PMOP*)mg->mg_obj;
-	mg->mg_obj = (SV*)pmop;
-	PmopSTASH_set(pmop,PL_curstash);
-    }
-
     return CHECKOP(type, pmop);
 }
 
@@ -3363,34 +3432,16 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
     pm = (PMOP*)o;
 
     if (expr->op_type == OP_CONST) {
-	STRLEN plen;
 	SV * const pat = ((SVOP*)expr)->op_sv;
-	const char *p = SvPV_const(pat, plen);
 	U32 pm_flags = pm->op_pmflags & PMf_COMPILETIME;
-	if ((o->op_flags & OPf_SPECIAL) && (plen == 1 && *p == ' ')) {
-	    U32 was_readonly = SvREADONLY(pat);
 
-	    if (was_readonly) {
-		if (SvFAKE(pat)) {
-		    sv_force_normal_flags(pat, 0);
-		    assert(!SvREADONLY(pat));
-		    was_readonly = 0;
-		} else {
-		    SvREADONLY_off(pat);
-		}
-	    }   
+	if (o->op_flags & OPf_SPECIAL)
+	    pm_flags |= RXf_SPLIT;
 
-	    sv_setpvn(pat, "\\s+", 3);
-
-	    SvFLAGS(pat) |= was_readonly;
-
-	    p = SvPV_const(pat, plen);
-	    pm_flags |= RXf_SKIPWHITE;
-	}
-        if (DO_UTF8(pat))
+	if (DO_UTF8(pat))
 	    pm_flags |= RXf_UTF8;
-	/* FIXME - can we make this function take const char * args?  */
-	PM_SETRE(pm, CALLREGCOMP((char*)p, (char*)p + plen, pm_flags));
+
+	PM_SETRE(pm, CALLREGCOMP(pat, pm_flags));
 
 #ifdef PERL_MAD
 	op_getmad(expr,(OP*)pm,'e');
@@ -3437,8 +3488,8 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 	OP *curop;
 	if (pm->op_pmflags & PMf_EVAL) {
 	    curop = NULL;
-	    if (CopLINE(PL_curcop) < (line_t)PL_multi_end)
-		CopLINE_set(PL_curcop, (line_t)PL_multi_end);
+	    if (CopLINE(PL_curcop) < (line_t)PL_parser->multi_end)
+		CopLINE_set(PL_curcop, (line_t)PL_parser->multi_end);
 	}
 	else if (repl->op_type == OP_CONST)
 	    curop = repl;
@@ -3502,8 +3553,9 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 	    rcop->op_next = LINKLIST(repl);
 	    repl->op_next = (OP*)rcop;
 
-	    pm->op_pmreplroot = scalar((OP*)rcop);
-	    pm->op_pmreplstart = LINKLIST(rcop);
+	    pm->op_pmreplrootu.op_pmreplroot = scalar((OP*)rcop);
+	    assert(!(pm->op_pmflags & PMf_ONCE));
+	    pm->op_pmstashstartu.op_pmreplstart = LINKLIST(rcop);
 	    rcop->op_next = 0;
 	}
     }
@@ -3601,11 +3653,12 @@ Perl_package(pTHX_ OP *o)
     save_item(PL_curstname);
 
     PL_curstash = gv_stashsv(sv, GV_ADD);
+
     sv_setsv(PL_curstname, sv);
 
     PL_hints |= HINT_BLOCK_SCOPE;
-    PL_copline = NOLINE;
-    PL_expect = XSTATE;
+    PL_parser->copline = NOLINE;
+    PL_parser->expect = XSTATE;
 
 #ifndef PERL_MAD
     op_free(o);
@@ -3729,8 +3782,8 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
      */
 
     PL_hints |= HINT_BLOCK_SCOPE;
-    PL_copline = NOLINE;
-    PL_expect = XSTATE;
+    PL_parser->copline = NOLINE;
+    PL_parser->expect = XSTATE;
     PL_cop_seqmax++; /* Purely for B::*'s benefit */
 
 #ifdef PERL_MAD
@@ -3808,17 +3861,19 @@ Perl_vload_module(pTHX_ U32 flags, SV *name, SV *ver, va_list *args)
 	    sv = va_arg(*args, SV*);
 	}
     }
-    {
-	const line_t ocopline = PL_copline;
-	COP * const ocurcop = PL_curcop;
-	const int oexpect = PL_expect;
 
-	utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
-		veop, modname, imop);
-	PL_expect = oexpect;
-	PL_copline = ocopline;
-	PL_curcop = ocurcop;
-    }
+    /* utilize() fakes up a BEGIN { require ..; import ... }, so make sure
+     * that it has a PL_parser to play with while doing that, and also
+     * that it doesn't mess with any existing parser, by creating a tmp
+     * new parser with lex_start(). This won't actually be used for much,
+     * since pp_require() will create another parser for the real work. */
+
+    ENTER;
+    SAVEVPTR(PL_curcop);
+    lex_start(NULL, NULL, FALSE);
+    utilize(!(flags & PERL_LOADMOD_DENY), start_subparse(FALSE, 0),
+	    veop, modname, imop);
+    LEAVE;
 }
 
 OP *
@@ -3919,12 +3974,14 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
     }
 
     if (is_list_assignment(left)) {
+	static const char no_list_state[] = "Initialization of state variables"
+	    " in list context currently forbidden";
 	OP *curop;
 
 	PL_modcount = 0;
 	/* Grandfathering $[ assignment here.  Bletch.*/
 	/* Only simple assignments like C<< ($[) = 1 >> are allowed */
-	PL_eval_start = (left->op_type == OP_CONST) ? right : 0;
+	PL_eval_start = (left->op_type == OP_CONST) ? right : NULL;
 	left = mod(left, OP_AASSIGN);
 	if (PL_eval_start)
 	    PL_eval_start = 0;
@@ -3984,19 +4041,24 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			    break;
 		    }
 		    else if (curop->op_type == OP_PUSHRE) {
-			if (((PMOP*)curop)->op_pmreplroot) {
 #ifdef USE_ITHREADS
-			    GV *gv = (GV*)PAD_SVl(INT2PTR(PADOFFSET,
-					((PMOP*)curop)->op_pmreplroot));
-#else
-			    GV *gv = (GV*)((PMOP*)curop)->op_pmreplroot;
-#endif
+			if (((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff) {
+			    GV *const gv = (GV*)PAD_SVl(((PMOP*)curop)->op_pmreplrootu.op_pmtargetoff);
 			    if (gv == PL_defgv
 				|| (int)GvASSIGN_GENERATION(gv) == PL_generation)
 				break;
 			    GvASSIGN_GENERATION_set(gv, PL_generation);
+			}
+#else
+			GV *const gv
+			    = ((PMOP*)curop)->op_pmreplrootu.op_pmtargetgv;
+			if (gv) {
+			    if (gv == PL_defgv
+				|| (int)GvASSIGN_GENERATION(gv) == PL_generation)
+				break;
 			    GvASSIGN_GENERATION_set(gv, PL_generation);
 			}
+#endif
 		    }
 		    else
 			break;
@@ -4007,28 +4069,30 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		o->op_private |= OPpASSIGN_COMMON;
 	}
 
-	if ( ((left->op_private & OPpLVAL_INTRO) || ckWARN(WARN_MISC))
-		&& (left->op_type == OP_LIST
-		    || (left->op_type == OP_NULL && left->op_targ == OP_LIST)))
-	{
+	if ((left->op_type == OP_LIST
+	     || (left->op_type == OP_NULL && left->op_targ == OP_LIST))) {
 	    OP* lop = ((LISTOP*)left)->op_first;
 	    while (lop) {
 		if (lop->op_type == OP_PADSV ||
 		    lop->op_type == OP_PADAV ||
 		    lop->op_type == OP_PADHV ||
-		    lop->op_type == OP_PADANY)
-		{
+		    lop->op_type == OP_PADANY) {
 		    if (lop->op_private & OPpPAD_STATE) {
 			if (left->op_private & OPpLVAL_INTRO) {
-			    o->op_private |= OPpASSIGN_STATE;
-			    /* hijacking PADSTALE for uninitialized state variables */
-			    SvPADSTALE_on(PAD_SVl(lop->op_targ));
+			    /* Each variable in state($a, $b, $c) = ... */
 			}
-			else { /* we already checked for WARN_MISC before */
-			    Perl_warner(aTHX_ packWARN(WARN_MISC), "State variable %s will be reinitialized",
-				    PAD_COMPNAME_PV(lop->op_targ));
+			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 {
+		    /* Other ops in the list. undef may be interesting in
+		       (state $a, undef, state $c) */
 		}
 		lop = lop->op_sibling;
 	    }
@@ -4040,12 +4104,20 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		    || left->op_type == OP_PADHV
 		    || left->op_type == OP_PADANY))
 	{
-	    o->op_private |= OPpASSIGN_STATE;
-	    /* hijacking PADSTALE for uninitialized state variables */
-	    SvPADSTALE_on(PAD_SVl(left->op_targ));
-	}
-
-	if (right && right->op_type == OP_SPLIT) {
+	    /* All single variable list context state assignments, hence
+	       state ($a) = ...
+	       (state $a) = ...
+	       state @a = ...
+	       state (@a) = ...
+	       (state @a) = ...
+	       state %a = ...
+	       state (%a) = ...
+	       (state %a) = ...
+	    */
+	    yyerror(no_list_state);
+	}
+
+	if (right && right->op_type == OP_SPLIT && !PL_madskills) {
 	    OP* tmpop = ((LISTOP*)right)->op_first;
 	    if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
 		PMOP * const pm = (PMOP*)tmpop;
@@ -4054,12 +4126,20 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		    !(o->op_private & OPpASSIGN_COMMON) )
 		{
 		    tmpop = ((UNOP*)left)->op_first;
-		    if (tmpop->op_type == OP_GV && !pm->op_pmreplroot) {
+		    if (tmpop->op_type == OP_GV
+#ifdef USE_ITHREADS
+			&& !pm->op_pmreplrootu.op_pmtargetoff
+#else
+			&& !pm->op_pmreplrootu.op_pmtargetgv
+#endif
+			) {
 #ifdef USE_ITHREADS
-			pm->op_pmreplroot = INT2PTR(OP*, cPADOPx(tmpop)->op_padix);
+			pm->op_pmreplrootu.op_pmtargetoff
+			    = cPADOPx(tmpop)->op_padix;
 			cPADOPx(tmpop)->op_padix = 0;	/* steal it */
 #else
-			pm->op_pmreplroot = (OP*)cSVOPx(tmpop)->op_sv;
+			pm->op_pmreplrootu.op_pmtargetgv
+			    = (GV*)cSVOPx(tmpop)->op_sv;
 			cSVOPx(tmpop)->op_sv = NULL;	/* steal it */
 #endif
 			pm->op_pmflags |= PMf_ONCE;
@@ -4067,11 +4147,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 			tmpop = ((UNOP*)tmpop)->op_first; /* to pushmark */
 			tmpop->op_sibling = NULL;	/* don't free split */
 			right->op_next = tmpop->op_next;  /* fix starting loc */
-#ifdef PERL_MAD
-			op_getmad(o,right,'R');		/* blow off assign */
-#else
 			op_free(o);			/* blow off assign */
-#endif
 			right->op_flags &= ~OPf_WANT;
 				/* "I don't know and I don't care." */
 			return right;
@@ -4152,11 +4228,12 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	HINTS_REFCNT_UNLOCK;
     }
 
-    if (PL_copline == NOLINE)
+    if (PL_parser && PL_parser->copline == NOLINE)
         CopLINE_set(cop, CopLINE(PL_curcop));
     else {
-	CopLINE_set(cop, PL_copline);
-        PL_copline = NOLINE;
+	CopLINE_set(cop, PL_parser->copline);
+	if (PL_parser)
+	    PL_parser->copline = NOLINE;
     }
 #ifdef USE_ITHREADS
     CopFILE_set(cop, CopFILE(PL_curcop));	/* XXX share in a pvtable? */
@@ -4203,7 +4280,8 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
     if (first->op_type == OP_NOT
 	&& (first->op_flags & OPf_SPECIAL)
-	&& (first->op_flags & OPf_KIDS)) {
+	&& (first->op_flags & OPf_KIDS)
+	&& !PL_madskills) {
 	if (type == OP_AND || type == OP_OR) {
 	    if (type == OP_AND)
 		type = OP_OR;
@@ -4214,11 +4292,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	    if (o->op_next)
 		first->op_next = o->op_next;
 	    cUNOPo->op_first = NULL;
-#ifdef PERL_MAD
-	    op_getmad(o,first,'O');
-#else
 	    op_free(o);
-#endif
 	}
     }
     if (first->op_type == OP_CONST) {
@@ -4253,6 +4327,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	    if ((o2->op_type == OP_PADSV || o2->op_type == OP_PADAV
 			|| o2->op_type == OP_PADHV)
 		&& o2->op_private & OPpLVAL_INTRO
+		&& !(o2->op_private & OPpPAD_STATE)
 		&& ckWARN(WARN_DEPRECATED))
 	    {
 		Perl_warner(aTHX_ packWARN(WARN_DEPRECATED),
@@ -4302,7 +4377,7 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	}
 	if (warnop) {
 	    const line_t oldline = CopLINE(PL_curcop);
-	    CopLINE_set(PL_curcop, PL_copline);
+	    CopLINE_set(PL_curcop, PL_parser->copline);
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
 		 "Value of %s%s can be \"0\"; test with defined()",
 		 PL_op_desc[warnop],
@@ -4571,7 +4646,7 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
     redo = LINKLIST(listop);
 
     if (expr) {
-	PL_copline = (line_t)whileline;
+	PL_parser->copline = (line_t)whileline;
 	scalar(listop);
 	o = new_logop(OP_AND, 0, &expr, &listop);
 	if (o == expr && o->op_type == OP_CONST && !SvTRUE(cSVOPo->op_sv)) {
@@ -4730,7 +4805,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
     if (madsv)
 	op_getmad(madsv, (OP*)loop, 'v');
-    PL_copline = forline;
+    PL_parser->copline = forline;
     return newSTATEOP(0, label, wop);
 }
 
@@ -4746,7 +4821,7 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 	    o = newOP(type, OPf_SPECIAL);
 	else {
 	    o = newPVOP(type, 0, savesharedpv(label->op_type == OP_CONST
-					? SvPVx_nolen_const(((SVOP*)label)->op_sv)
+					? SvPV_nolen_const(((SVOP*)label)->op_sv)
 					: ""));
 	}
 #ifdef PERL_MAD
@@ -4953,6 +5028,12 @@ void
 Perl_cv_undef(pTHX_ CV *cv)
 {
     dVAR;
+
+    DEBUG_X(PerlIO_printf(Perl_debug_log,
+	  "CV undef: cv=0x%"UVxf" comppad=0x%"UVxf"\n",
+	    PTR2UV(cv), PTR2UV(PL_comppad))
+    );
+
 #ifdef USE_ITHREADS
     if (CvFILE(cv) && !CvISXSUB(cv)) {
 	/* for XSUBs CvFILE point directly to static memory; __FILE__ */
@@ -5079,6 +5160,9 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
     dVAR;
     SV *sv = NULL;
 
+    if (PL_madskills)
+	return NULL;
+
     if (!o)
 	return NULL;
 
@@ -5183,11 +5267,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	= (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
 	   || PL_madskills)
 	? GV_ADDMULTI : GV_ADDMULTI | GV_NOINIT;
-    const char * const name = o ? SvPVx_nolen_const(cSVOPo->op_sv) : NULL;
+    const char * const name = o ? SvPV_nolen_const(cSVOPo->op_sv) : NULL;
 
     if (proto) {
 	assert(proto->op_type == OP_CONST);
-	ps = SvPVx_const(((SVOP*)proto)->op_sv, ps_len);
+	ps = SvPV_const(((SVOP*)proto)->op_sv, ps_len);
     }
     else
 	ps = NULL;
@@ -5230,9 +5314,9 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    sv_setpvn((SV*)gv, ps, ps_len);
 	else
 	    sv_setiv((SV*)gv, -1);
+
 	SvREFCNT_dec(PL_compcv);
 	cv = PL_compcv = NULL;
-	PL_sub_generation++;
 	goto done;
     }
 
@@ -5294,8 +5378,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 			&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
 		{
 		    const line_t oldline = CopLINE(PL_curcop);
-		    if (PL_copline != NOLINE)
-			CopLINE_set(PL_curcop, PL_copline);
+		    if (PL_parser && PL_parser->copline != NOLINE)
+			CopLINE_set(PL_curcop, PL_parser->copline);
 		    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
 			CvCONST(cv) ? "Constant subroutine %s redefined"
 				    : "Subroutine %s redefined", name);
@@ -5326,7 +5410,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    GvCV(gv) = NULL;
 	    cv = newCONSTSUB(NULL, name, const_sv);
 	}
-	PL_sub_generation++;
+        mro_method_changed_in( /* sub Foo::Bar () { 123 } */
+            (CvGV(cv) && GvSTASH(CvGV(cv)))
+                ? GvSTASH(CvGV(cv))
+                : CvSTASH(cv)
+                    ? CvSTASH(cv)
+                    : PL_curstash
+        );
 	if (PL_madskills)
 	    goto install_block;
 	op_free(block);
@@ -5409,7 +5499,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		}
 	    }
 	    GvCVGEN(gv) = 0;
-	    PL_sub_generation++;
+            mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar { (shift)+1 } */
 	}
     }
     CvGV(cv) = gv;
@@ -5419,7 +5509,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (ps)
 	sv_setpvn((SV*)cv, ps, ps_len);
 
-    if (PL_error_count) {
+    if (PL_parser && PL_parser->error_count) {
 	op_free(block);
 	block = NULL;
 	if (name) {
@@ -5490,7 +5580,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 			   CopFILE(PL_curcop),
 			   (long)PL_subline, (long)CopLINE(PL_curcop));
 	    gv_efullname3(tmpstr, gv, NULL);
-	    hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr), SvCUR(tmpstr), sv, 0);
+	    (void)hv_store(GvHV(PL_DBsub), SvPVX_const(tmpstr),
+		    SvCUR(tmpstr), sv, 0);
 	    hv = GvHVn(db_postponed);
 	    if (HvFILL(hv) > 0 && hv_exists(hv, SvPVX_const(tmpstr), SvCUR(tmpstr))) {
 		CV * const pcv = GvCV(db_postponed);
@@ -5504,12 +5595,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    }
 	}
 
-	if (name && !PL_error_count)
+	if (name && ! (PL_parser && PL_parser->error_count))
 	    process_special_blocks(name, gv, cv);
     }
 
   done:
-    PL_copline = NOLINE;
+    if (PL_parser)
+	PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
     return cv;
 }
@@ -5605,7 +5697,7 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     ENTER;
 
     SAVECOPLINE(PL_curcop);
-    CopLINE_set(PL_curcop, PL_copline);
+    CopLINE_set(PL_curcop, PL_parser ? PL_parser->copline : NOLINE);
 
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
@@ -5718,8 +5810,8 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 			const char *redefined_name = HvNAME_get(stash);
 			if ( strEQ(redefined_name,"autouse") ) {
 			    const line_t oldline = CopLINE(PL_curcop);
-			    if (PL_copline != NOLINE)
-				CopLINE_set(PL_curcop, PL_copline);
+			    if (PL_parser && PL_parser->copline != NOLINE)
+				CopLINE_set(PL_curcop, PL_parser->copline);
 			    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
 					CvCONST(cv) ? "Constant subroutine %s redefined"
 						    : "Subroutine %s redefined"
@@ -5741,7 +5833,7 @@ Perl_newXS(pTHX_ const char *name, XSUBADDR_t subaddr, const char *filename)
 	if (name) {
 	    GvCV(gv) = cv;
 	    GvCVGEN(gv) = 0;
-	    PL_sub_generation++;
+            mro_method_changed_in(GvSTASH(gv)); /* newXS */
 	}
     }
     CvGV(cv) = gv;
@@ -5785,8 +5877,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     if ((cv = GvFORM(gv))) {
 	if (ckWARN(WARN_REDEFINE)) {
 	    const line_t oldline = CopLINE(PL_curcop);
-	    if (PL_copline != NOLINE)
-		CopLINE_set(PL_curcop, PL_copline);
+	    if (PL_parser && PL_parser->copline != NOLINE)
+		CopLINE_set(PL_curcop, PL_parser->copline);
 	    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
 			o ? "Format %"SVf" redefined"
 			: "Format STDOUT redefined", SVfARG(cSVOPo->op_sv));
@@ -5813,7 +5905,8 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 #else
     op_free(o);
 #endif
-    PL_copline = NOLINE;
+    if (PL_parser)
+	PL_parser->copline = NOLINE;
     LEAVE_SCOPE(floor);
 #ifdef PERL_MAD
     return pegop;
@@ -6205,7 +6298,8 @@ Perl_ck_exists(pTHX_ OP *o)
 	OP * const kid = cUNOPo->op_first;
 	if (kid->op_type == OP_ENTERSUB) {
 	    (void) ref(kid, o->op_type);
-	    if (kid->op_type != OP_RV2CV && !PL_error_count)
+	    if (kid->op_type != OP_RV2CV
+			&& !(PL_parser && PL_parser->error_count))
 		Perl_croak(aTHX_ "%s argument is not a subroutine name",
 			    OP_DESC(o));
 	    o->op_private |= OPpEXISTS_SUB;
@@ -6721,7 +6815,7 @@ Perl_ck_grep(pTHX_ OP *o)
     PADOFFSET offset;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
-    /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
+    /* don't allocate gwop here, as we may leak it if PL_parser->error_count > 0 */
 
     if (o->op_flags & OPf_STACKED) {
 	OP* k;
@@ -6742,7 +6836,7 @@ Perl_ck_grep(pTHX_ OP *o)
     else
 	scalar(kid);
     o = ck_fun(o);
-    if (PL_error_count)
+    if (PL_parser && PL_parser->error_count)
 	return o;
     kid = cLISTOPo->op_first->op_sibling;
     if (kid->op_type != OP_NULL)
@@ -6930,7 +7024,10 @@ Perl_ck_sassign(pTHX_ OP *o)
     if ((PL_opargs[kid->op_type] & OA_TARGLEX)
 	&& !(kid->op_flags & OPf_STACKED)
 	/* Cannot steal the second time! */
-	&& !(kid->op_private & OPpTARGET_MY))
+	&& !(kid->op_private & OPpTARGET_MY)
+	/* Keep the full thing for madskills */
+	&& !PL_madskills
+	)
     {
 	OP * const kkid = kid->op_sibling;
 
@@ -6943,13 +7040,8 @@ Perl_ck_sassign(pTHX_ OP *o)
 	    /* Now we do not need PADSV and SASSIGN. */
 	    kid->op_sibling = o->op_sibling;	/* NULL */
 	    cLISTOPo->op_first = NULL;
-#ifdef PERL_MAD
-	    op_getmad(o,kid,'O');
-	    op_getmad(kkid,kid,'M');
-#else
 	    op_free(o);
 	    op_free(kkid);
-#endif
 	    kid->op_private |= OPpTARGET_MY;	/* Used for context settings */
 	    return kid;
 	}
@@ -6959,9 +7051,27 @@ Perl_ck_sassign(pTHX_ OP *o)
 	if (kkid->op_type == OP_PADSV
 		&& (kkid->op_private & OPpLVAL_INTRO)
 		&& SvPAD_STATE(*av_fetch(PL_comppad_name, kkid->op_targ, FALSE))) {
-	    o->op_private |= OPpASSIGN_STATE;
+	    const PADOFFSET target = kkid->op_targ;
+	    OP *const other = newOP(OP_PADSV,
+				    kkid->op_flags
+				    | ((kkid->op_private & ~OPpLVAL_INTRO) << 8));
+	    OP *const first = newOP(OP_NULL, 0);
+	    OP *const nullop = newCONDOP(0, first, o, other);
+	    OP *const condop = first->op_next;
 	    /* hijacking PADSTALE for uninitialized state variables */
-	    SvPADSTALE_on(PAD_SVl(kkid->op_targ));
+	    SvPADSTALE_on(PAD_SVl(target));
+
+	    condop->op_type = OP_ONCE;
+	    condop->op_ppaddr = PL_ppaddr[OP_ONCE];
+	    condop->op_targ = target;
+	    other->op_targ = target;
+
+	    /* Because we change the type of the op here, we will skip the
+	       assinment binop->op_last = binop->op_first->op_sibling; at the
+	       end of Perl_newBINOP(). So need to do it here. */
+	    cBINOPo->op_last = cBINOPo->op_first->op_sibling;
+
+	    return nullop;
 	}
     }
     return o;
@@ -7477,26 +7587,6 @@ Perl_ck_subr(pTHX_ OP *o)
 		    proto = SvPV((SV*)cv, len);
 		    proto_end = proto + len;
 		}
-		if (CvASSERTION(cv)) {
-		    U32 asserthints = 0;
-		    HV *const hinthv = GvHV(PL_hintgv);
-		    if (hinthv) {
-			SV **svp = hv_fetchs(hinthv, "assertions", FALSE);
-			if (svp && *svp)
-			    asserthints = SvUV(*svp);
-		    }
-		    if (asserthints & HINT_ASSERTING) {
-			if (PERLDB_ASSERTION && PL_curstash != PL_debstash)
-			    o->op_private |= OPpENTERSUB_DB;
-		    }
-		    else {
-			delete_op = 1;
-			if (!(asserthints & HINT_ASSERTIONSSEEN) && ckWARN(WARN_ASSERTIONS)) {
-			    Perl_warner(aTHX_ packWARN(WARN_ASSERTIONS),
-					"Impossible to activate assertion call");
-			}
-		    }
-		}
 	    }
 	}
     }
@@ -7802,13 +7892,15 @@ Perl_peep(pTHX_ register OP *o)
     for (; o; o = o->op_next) {
 	if (o->op_opt)
 	    break;
+	/* By default, this op has now been optimised. A couple of cases below
+	   clear this again.  */
+	o->op_opt = 1;
 	PL_op = o;
 	switch (o->op_type) {
 	case OP_SETSTATE:
 	case OP_NEXTSTATE:
 	case OP_DBSTATE:
 	    PL_curcop = ((COP*)o);		/* for warnings */
-	    o->op_opt = 1;
 	    break;
 
 	case OP_CONST:
@@ -7851,14 +7943,13 @@ Perl_peep(pTHX_ register OP *o)
 		o->op_targ = ix;
 	    }
 #endif
-	    o->op_opt = 1;
 	    break;
 
 	case OP_CONCAT:
 	    if (o->op_next && o->op_next->op_type == OP_STRINGIFY) {
 		if (o->op_next->op_private & OPpTARGET_MY) {
 		    if (o->op_flags & OPf_STACKED) /* chained concats */
-			goto ignore_optimization;
+			break; /* ignore_optimization */
 		    else {
 			/* assert(PL_opargs[o->op_type] & OA_TARGLEX); */
 			o->op_targ = o->op_next->op_targ;
@@ -7868,12 +7959,9 @@ Perl_peep(pTHX_ register OP *o)
 		}
 		op_null(o->op_next);
 	    }
-	  ignore_optimization:
-	    o->op_opt = 1;
 	    break;
 	case OP_STUB:
 	    if ((o->op_flags & OPf_WANT) != OPf_WANT_LIST) {
-		o->op_opt = 1;
 		break; /* Scalar stub must produce undef.  List stub is noop */
 	    }
 	    goto nothin;
@@ -7889,20 +7977,17 @@ Perl_peep(pTHX_ register OP *o)
 	       has already occurred. This doesn't fix the real problem,
 	       though (See 20010220.007). AMS 20010719 */
 	    /* op_seq functionality is now replaced by op_opt */
-	    if (oldop && o->op_next) {
-		oldop->op_next = o->op_next;
-		continue;
-	    }
-	    break;
+	    o->op_opt = 0;
+	    /* FALL THROUGH */
 	case OP_SCALAR:
 	case OP_LINESEQ:
 	case OP_SCOPE:
-	  nothin:
+	nothin:
 	    if (oldop && o->op_next) {
 		oldop->op_next = o->op_next;
+		o->op_opt = 0;
 		continue;
 	    }
-	    o->op_opt = 1;
 	    break;
 
 	case OP_PADAV:
@@ -7939,7 +8024,6 @@ Perl_peep(pTHX_ register OP *o)
 			o->op_flags |= OPf_SPECIAL;
 		    o->op_type = OP_AELEMFAST;
 		}
-    		o->op_opt = 1;
 		break;
 	    }
 
@@ -7976,7 +8060,6 @@ Perl_peep(pTHX_ register OP *o)
 		op_null(o->op_next);
 	    }
 
-	    o->op_opt = 1;
 	    break;
 
 	case OP_MAPWHILE:
@@ -7989,7 +8072,7 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_DORASSIGN:
 	case OP_COND_EXPR:
 	case OP_RANGE:
-	    o->op_opt = 1;
+	case OP_ONCE:
 	    while (cLOGOP->op_other->op_type == OP_NULL)
 		cLOGOP->op_other = cLOGOP->op_other->op_next;
 	    peep(cLOGOP->op_other); /* Recursive calls are not replaced by fptr calls */
@@ -7997,7 +8080,6 @@ Perl_peep(pTHX_ register OP *o)
 
 	case OP_ENTERLOOP:
 	case OP_ENTERITER:
-	    o->op_opt = 1;
 	    while (cLOOP->op_redoop->op_type == OP_NULL)
 		cLOOP->op_redoop = cLOOP->op_redoop->op_next;
 	    peep(cLOOP->op_redoop);
@@ -8009,18 +8091,16 @@ Perl_peep(pTHX_ register OP *o)
 	    peep(cLOOP->op_lastop);
 	    break;
 
-	case OP_QR:
-	case OP_MATCH:
 	case OP_SUBST:
-	    o->op_opt = 1;
-	    while (cPMOP->op_pmreplstart &&
-		   cPMOP->op_pmreplstart->op_type == OP_NULL)
-		cPMOP->op_pmreplstart = cPMOP->op_pmreplstart->op_next;
-	    peep(cPMOP->op_pmreplstart);
+	    assert(!(cPMOP->op_pmflags & PMf_ONCE));
+	    while (cPMOP->op_pmstashstartu.op_pmreplstart &&
+		   cPMOP->op_pmstashstartu.op_pmreplstart->op_type == OP_NULL)
+		cPMOP->op_pmstashstartu.op_pmreplstart
+		    = cPMOP->op_pmstashstartu.op_pmreplstart->op_next;
+	    peep(cPMOP->op_pmstashstartu.op_pmreplstart);
 	    break;
 
 	case OP_EXEC:
-	    o->op_opt = 1;
 	    if (o->op_next && o->op_next->op_type == OP_NEXTSTATE
 		&& ckWARN(WARN_SYNTAX))
 	    {
@@ -8047,8 +8127,6 @@ Perl_peep(pTHX_ register OP *o)
 	    const char *key = NULL;
 	    STRLEN keylen;
 
-	    o->op_opt = 1;
-
 	    if (((BINOP*)o)->op_last->op_type != OP_CONST)
 		break;
 
@@ -8175,8 +8253,6 @@ Perl_peep(pTHX_ register OP *o)
 
 	    /* make @a = sort @a act in-place */
 
-	    o->op_opt = 1;
-
 	    oright = cUNOPx(oright)->op_sibling;
 	    if (!oright)
 		break;
@@ -8267,7 +8343,6 @@ Perl_peep(pTHX_ register OP *o)
 	    OP *ourmark, *theirmark, *ourlast, *iter, *expushmark, *rv2av;
 	    OP *gvop = NULL;
 	    LISTOP *enter, *exlist;
-	    o->op_opt = 1;
 
 	    enter = (LISTOP *) o->op_next;
 	    if (!enter)
@@ -8358,13 +8433,6 @@ Perl_peep(pTHX_ register OP *o)
 	    UNOP *refgen, *rv2cv;
 	    LISTOP *exlist;
 
-	    /* I do not understand this, but if o->op_opt isn't set to 1,
-	       various tests in ext/B/t/bytecode.t fail with no readily
-	       apparent cause.  */
-
-	    o->op_opt = 1;
-
-
 	    if ((o->op_flags && OPf_WANT) != OPf_WANT_VOID)
 		break;
 
@@ -8405,8 +8473,11 @@ Perl_peep(pTHX_ register OP *o)
 	}
 
 	
-	default:
-	    o->op_opt = 1;
+	case OP_QR:
+	case OP_MATCH:
+	    if (!(cPMOP->op_pmflags & PMf_ONCE)) {
+		assert (!cPMOP->op_pmstashstartu.op_pmreplstart);
+	    }
 	    break;
 	}
 	oldop = o;
@@ -8414,7 +8485,7 @@ Perl_peep(pTHX_ register OP *o)
     LEAVE;
 }
 
-char*
+const char*
 Perl_custom_op_name(pTHX_ const OP* o)
 {
     dVAR;
@@ -8434,7 +8505,7 @@ Perl_custom_op_name(pTHX_ const OP* o)
     return SvPV_nolen(HeVAL(he));
 }
 
-char*
+const char*
 Perl_custom_op_desc(pTHX_ const OP* o)
 {
     dVAR;