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

diff --git a/op.c b/op.c
index 58dba8f..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,9 +450,6 @@ 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;
@@ -451,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);
     }
 
@@ -625,7 +651,11 @@ S_cop_free(pTHX_ COP* cop)
 }
 
 STATIC void
-S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
+S_forget_pmop(pTHX_ PMOP *const o
+#ifdef USE_ITHREADS
+	      , U32 flags
+#endif
+	      )
 {
     HV * const pmstash = PmopSTASH(o);
     if (pmstash && !SvIS_FREED(pmstash)) {
@@ -652,8 +682,12 @@ S_forget_pmop(pTHX_ PMOP *const o, U32 flags)
 	    }
 	}
     }
+    if (PL_curpm == o) 
+	PL_curpm = NULL;
+#ifdef USE_ITHREADS
     if (flags)
 	PmopSTASH_free(o);
+#endif
 }
 
 STATIC void
@@ -757,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);
 	}
@@ -773,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;
@@ -871,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;
@@ -1116,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;
@@ -1242,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)
@@ -1275,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:
@@ -1624,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;
@@ -1670,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) {
@@ -1792,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"
@@ -1919,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;
@@ -1944,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) :
@@ -1965,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);
@@ -1982,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;
 }
@@ -2016,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;
 }
 
@@ -2235,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 */
@@ -2261,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");
 	    }
 	}
     }
@@ -2270,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;
 }
 
@@ -2337,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)) {
@@ -2423,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);
@@ -2771,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);
@@ -2792,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:
@@ -3385,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);
-		}
-	    }   
 
-	    sv_setpvn(pat, "\\s+", 3);
+	if (o->op_flags & OPf_SPECIAL)
+	    pm_flags |= RXf_SPLIT;
 
-	    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');
@@ -3459,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;
@@ -3624,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);
@@ -3752,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
@@ -3831,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 *
@@ -3942,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;
@@ -4035,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;
 	    }
@@ -4068,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;
@@ -4103,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;
@@ -4188,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? */
@@ -4239,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;
@@ -4250,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) {
@@ -4289,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),
@@ -4338,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],
@@ -4607,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)) {
@@ -4766,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);
 }
 
@@ -4782,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
@@ -4989,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__ */
@@ -5115,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;
 
@@ -5219,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;
@@ -5266,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;
     }
 
@@ -5330,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);
@@ -5362,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);
@@ -5445,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;
@@ -5455,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) {
@@ -5526,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);
@@ -5540,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;
 }
@@ -5641,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;
@@ -5754,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"
@@ -5777,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;
@@ -5821,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));
@@ -5849,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;
@@ -6241,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;
@@ -6757,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;
@@ -6778,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)
@@ -6966,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;
 
@@ -6979,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;
 	}
@@ -6995,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;
@@ -7513,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");
-			}
-		    }
-		}
 	    }
 	}
     }
@@ -8018,6 +8072,7 @@ Perl_peep(pTHX_ register OP *o)
 	case OP_DORASSIGN:
 	case OP_COND_EXPR:
 	case OP_RANGE:
+	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 */
@@ -8430,7 +8485,7 @@ Perl_peep(pTHX_ register OP *o)
     LEAVE;
 }
 
-char*
+const char*
 Perl_custom_op_name(pTHX_ const OP* o)
 {
     dVAR;
@@ -8450,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;