X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=op.c;h=f5e24fcdea3c5688410647ef03cd19fdf2965e8a;hb=51254d33a14eeacb273f244a97f13b86d9e56aa2;hp=1331b15dd9562183a058e7cb488d339475532d96;hpb=71fbae4b4b3f337a0c2643cc859be9d389fd2e98;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/op.c b/op.c
index 1331b15..f5e24fc 100644
--- a/op.c
+++ b/op.c
@@ -73,6 +73,28 @@ into peep() to do that code's portion of the 3rd pass.  It has to be
 recursive, but it's recursive on basic blocks, not on tree nodes.
 */
 
+/* To implement user lexical pragmas, there needs to be a way at run time to
+   get the compile time state of %^H for that block.  Storing %^H in every
+   block (or even COP) would be very expensive, so a different approach is
+   taken.  The (running) state of %^H is serialised into a tree of HE-like
+   structs.  Stores into %^H are chained onto the current leaf as a struct
+   refcounted_he * with the key and the value.  Deletes from %^H are saved
+   with a value of PL_sv_placeholder.  The state of %^H at any point can be
+   turned back into a regular HV by walking back up the tree from that point's
+   leaf, ignoring any key you've already seen (placeholder or not), storing
+   the rest into the HV structure, then removing the placeholders. Hence
+   memory is only used to store the %^H deltas from the enclosing COP, rather
+   than the entire %^H on each COP.
+
+   To cause actions on %^H to write out the serialisation records, it has
+   magic type 'H'. This magic (itself) does nothing, but its presence causes
+   the values to gain magic type 'h', which has entries for set and clear.
+   C<Perl_magic_sethint> updates C<PL_compiling.cop_hints> with a store
+   record, with deletes written by C<Perl_magic_clearhint>. C<SAVE_HINTS>
+   saves the current C<PL_compiling.cop_hints> on the save stack, so that it
+   will be correctly restored when any inner compiling scope is exited.
+*/
+
 #include "EXTERN.h"
 #define PERL_IN_OP_C
 #include "perl.h"
@@ -198,15 +220,17 @@ S_bad_type(pTHX_ I32 n, const char *t, const char *name, const OP *kid)
 STATIC void
 S_no_bareword_allowed(pTHX_ const OP *o)
 {
+    if (PL_madskills)
+	return;		/* various ok barewords are hidden in extra OP_NULL */
     qerror(Perl_mess(aTHX_
 		     "Bareword \"%"SVf"\" not allowed while \"strict subs\" in use",
-		     cSVOPo_sv));
+		     (void*)cSVOPo_sv));
 }
 
 /* "register" allocation */
 
 PADOFFSET
-Perl_allocmy(pTHX_ char *name)
+Perl_allocmy(pTHX_ const char *const name)
 {
     dVAR;
     PADOFFSET off;
@@ -221,25 +245,11 @@ Perl_allocmy(pTHX_ char *name)
     {
 	/* name[2] is true if strlen(name) > 2  */
 	if (!isPRINT(name[1]) || strchr("\t\n\r\f", name[1])) {
-	    /* 1999-02-27 mjd@plover.com */
-	    char *p;
-	    p = strchr(name, '\0');
-	    /* The next block assumes the buffer is at least 205 chars
-	       long.  At present, it's always at least 256 chars. */
-	    if (p-name > 200) {
-		strcpy(name+200, "...");
-		p = name+199;
-	    }
-	    else {
-		p[1] = '\0';
-	    }
-	    /* Move everything else down one character */
-	    for (; p-name > 2; p--)
-		*p = *(p-1);
-	    name[2] = toCTRL(name[1]);
-	    name[1] = '^';
+	    yyerror(Perl_form(aTHX_ "Can't use global %c^%c%s in \"my\"",
+			      name[0], toCTRL(name[1]), name + 2));
+	} else {
+	    yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
 	}
-	yyerror(Perl_form(aTHX_ "Can't use global %s in \"my\"",name));
     }
 
     /* check for duplicate declaration */
@@ -248,7 +258,8 @@ Perl_allocmy(pTHX_ char *name)
     if (PL_in_my_stash && *name != '$') {
 	yyerror(Perl_form(aTHX_
 		    "Can't declare class for non-scalar %s in \"%s\"",
-		     name, is_our ? "our" : "my"));
+ 		     name,
+ 		     is_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
     }
 
     /* allocate a spare slot and store the name in that slot */
@@ -260,7 +271,8 @@ Perl_allocmy(pTHX_ char *name)
 			? (PL_curstash && !strEQ(name,"$_") ? PL_curstash : PL_defstash)
 			: NULL
 		    ),
-		    0 /*  not fake */
+		    0, /*  not fake */
+		    PL_in_my == KEY_state
     );
     return off;
 }
@@ -327,8 +339,29 @@ Perl_op_clear(pTHX_ OP *o)
 {
 
     dVAR;
+#ifdef PERL_MAD
+    /* if (o->op_madprop && o->op_madprop->mad_next)
+       abort(); */
+    /* FIXME for MAD - if I uncomment these two lines t/op/pack.t fails with
+       "modification of a read only value" for a reason I can't fathom why.
+       It's the "" stringification of $_, where $_ was set to '' in a foreach
+       loop, but it defies simplification into a small test case.
+       However, commenting them out has caused ext/List/Util/t/weak.t to fail
+       the last test.  */
+    /*
+      mad_free(o->op_madprop);
+      o->op_madprop = 0;
+    */
+#endif    
+
+ retry:
     switch (o->op_type) {
     case OP_NULL:	/* Was holding old type, if any. */
+	if (PL_madskills && o->op_targ != OP_NULL) {
+	    o->op_type = o->op_targ;
+	    o->op_targ = 0;
+	    goto retry;
+	}
     case OP_ENTEREVAL:	/* Was holding hints. */
 	o->op_targ = 0;
 	break;
@@ -461,14 +494,15 @@ S_cop_free(pTHX_ COP* cop)
     CopFILE_free(cop);
     CopSTASH_free(cop);
     if (! specialWARN(cop->cop_warnings))
-	SvREFCNT_dec(cop->cop_warnings);
+	PerlMemShared_free(cop->cop_warnings);
     if (! specialCopIO(cop->cop_io)) {
 #ifdef USE_ITHREADS
-	/*EMPTY*/
+	NOOP;
 #else
 	SvREFCNT_dec(cop->cop_io);
 #endif
     }
+    Perl_refcounted_he_free(aTHX_ cop->cop_hints);
 }
 
 void
@@ -477,7 +511,8 @@ Perl_op_null(pTHX_ OP *o)
     dVAR;
     if (o->op_type == OP_NULL)
 	return;
-    op_clear(o);
+    if (!PL_madskills)
+	op_clear(o);
     o->op_targ = o->op_type;
     o->op_type = OP_NULL;
     o->op_ppaddr = PL_ppaddr[OP_NULL];
@@ -641,6 +676,21 @@ Perl_scalarvoid(pTHX_ OP *o)
     SV* sv;
     U8 want;
 
+    /* trailing mad null ops don't count as "there" for void processing */
+    if (PL_madskills &&
+    	o->op_type != OP_NULL &&
+	o->op_sibling &&
+	o->op_sibling->op_type == OP_NULL)
+    {
+	OP *sib;
+	for (sib = o->op_sibling;
+		sib && sib->op_type == OP_NULL;
+		sib = sib->op_sibling) ;
+	
+	if (!sib)
+	    return o;
+    }
+
     if (o->op_type == OP_NEXTSTATE
 	|| o->op_type == OP_SETSTATE
 	|| o->op_type == OP_DBSTATE
@@ -776,15 +826,17 @@ Perl_scalarvoid(pTHX_ OP *o)
 	else {
 	    if (ckWARN(WARN_VOID)) {
 		useless = "a constant";
+		if (o->op_private & OPpCONST_ARYBASE)
+		    useless = NULL;
 		/* don't warn on optimised away booleans, eg 
 		 * use constant Foo, 5; Foo || print; */
 		if (cSVOPo->op_private & OPpCONST_SHORTCIRCUIT)
-		    useless = 0;
+		    useless = NULL;
 		/* the constants 0 and 1 are permitted as they are
 		   conventionally used as dummies in constructs like
 		        1 while some_condition_with_side_effects;  */
 		else if (SvNIOK(sv) && (SvNV(sv) == 0.0 || SvNV(sv) == 1.0))
-		    useless = 0;
+		    useless = NULL;
 		else if (SvPOK(sv)) {
                   /* perl4's way of mixing documentation and code
                      (before the invention of POD) was based on a
@@ -796,7 +848,7 @@ Perl_scalarvoid(pTHX_ OP *o)
 		    if (strnEQ(maybe_macro, "di", 2) ||
 			strnEQ(maybe_macro, "ds", 2) ||
 			strnEQ(maybe_macro, "ig", 2))
-			    useless = 0;
+			    useless = NULL;
 		}
 	    }
 	}
@@ -968,10 +1020,10 @@ Perl_scalarseq(pTHX_ OP *o)
 {
     dVAR;
     if (o) {
-	if (o->op_type == OP_LINESEQ ||
-	     o->op_type == OP_SCOPE ||
-	     o->op_type == OP_LEAVE ||
-	     o->op_type == OP_LEAVETRY)
+	const OPCODE type = o->op_type;
+
+	if (type == OP_LINESEQ || type == OP_SCOPE ||
+	    type == OP_LEAVE || type == OP_LEAVETRY)
 	{
             OP *kid;
 	    for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling) {
@@ -1035,16 +1087,17 @@ Perl_mod(pTHX_ OP *o, I32 type)
 	PL_modcount++;
 	return o;
     case OP_CONST:
-	if (!(o->op_private & (OPpCONST_ARYBASE)))
+	if (!(o->op_private & OPpCONST_ARYBASE))
 	    goto nomod;
 	localize = 0;
 	if (PL_eval_start && PL_eval_start->op_type == OP_CONST) {
-	    PL_compiling.cop_arybase = (I32)SvIV(cSVOPx(PL_eval_start)->op_sv);
+	    CopARYBASE_set(&PL_compiling,
+			   (I32)SvIV(cSVOPx(PL_eval_start)->op_sv));
 	    PL_eval_start = 0;
 	}
 	else if (!type) {
-	    SAVEI32(PL_compiling.cop_arybase);
-	    PL_compiling.cop_arybase = 0;
+	    SAVECOPARYBASE(&PL_compiling);
+	    CopARYBASE_set(&PL_compiling, 0);
 	}
 	else if (type == OP_REFGEN)
 	    goto nomod;
@@ -1052,7 +1105,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)
+	if (o->op_flags & OPf_PARENS || PL_madskills)
 	    break;
 	goto nomod;
     case OP_ENTERSUB:
@@ -1083,15 +1136,14 @@ Perl_mod(pTHX_ OP *o, I32 type)
 		CV *cv;
 		OP *okid;
 
-		if (kid->op_type == OP_PUSHMARK)
-		    goto skip_kids;
-		if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
-		    Perl_croak(aTHX_
-			       "panic: unexpected lvalue entersub "
-			       "args: type/targ %ld:%"UVuf,
-			       (long)kid->op_type, (UV)kid->op_targ);
-		kid = kLISTOP->op_first;
-	      skip_kids:
+		if (kid->op_type != OP_PUSHMARK) {
+		    if (kid->op_type != OP_NULL || kid->op_targ != OP_LIST)
+			Perl_croak(aTHX_
+				"panic: unexpected lvalue entersub "
+				"args: type/targ %ld:%"UVuf,
+				(long)kid->op_type, (UV)kid->op_targ);
+		    kid = kLISTOP->op_first;
+		}
 		while (kid->op_sibling)
 		    kid = kid->op_sibling;
 		if (!(kid->op_type == OP_NULL && kid->op_targ == OP_RV2CV)) {
@@ -1549,6 +1601,10 @@ S_dup_attrlist(pTHX_ OP *o)
      */
     if (o->op_type == OP_CONST)
 	rop = newSVOP(OP_CONST, o->op_flags, SvREFCNT_inc_NN(cSVOPo->op_sv));
+#ifdef PERL_MAD
+    else if (o->op_type == OP_NULL)
+	rop = NULL;
+#endif
     else {
 	assert((o->op_type == OP_LIST) && (o->op_flags & OPf_KIDS));
 	rop = NULL;
@@ -1580,7 +1636,7 @@ S_apply_attrs(pTHX_ HV *stash, SV *target, OP *attrs, bool for_my)
 	/* Don't force the C<use> if we don't need it. */
 	SV * const * const svp = hv_fetchs(GvHVn(PL_incgv), ATTRSMODULE_PM, FALSE);
 	if (svp && *svp != &PL_sv_undef)
-	    /*EMPTY*/; 		/* already in %INC */
+	    NOOP;	/* already in %INC */
 	else
 	    Perl_load_module(aTHX_ PERL_LOADMOD_NOIMPORT,
 			     newSVpvs(ATTRSMODULE), NULL);
@@ -1701,18 +1757,28 @@ S_my_kid(pTHX_ OP *o, OP *attrs, OP **imopsp)
 	return o;
 
     type = o->op_type;
+    if (PL_madskills && type == OP_NULL && o->op_flags & OPf_KIDS) {
+	(void)my_kid(cUNOPo->op_first, attrs, imopsp);
+	return o;
+    }
+
     if (type == OP_LIST) {
         OP *kid;
 	for (kid = cLISTOPo->op_first; kid; kid = kid->op_sibling)
 	    my_kid(kid, attrs, imopsp);
-    } else if (type == OP_UNDEF) {
+    } else if (type == OP_UNDEF
+#ifdef PERL_MAD
+	       || type == OP_STUB
+#endif
+	       ) {
 	return o;
     } else if (type == OP_RV2SV ||	/* "our" declaration */
 	       type == OP_RV2AV ||
 	       type == OP_RV2HV) { /* XXX does this let anything illegal in? */
 	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" : "my"));
+			OP_DESC(o),
+			PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
 	} else if (attrs) {
 	    GV * const gv = cGVOPx_gv(cUNOPo->op_first);
 	    PL_in_my = FALSE;
@@ -1733,7 +1799,7 @@ 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" : "my"));
+			  PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my"));
 	return o;
     }
     else if (attrs && type != OP_PUSHMARK) {
@@ -1750,6 +1816,8 @@ 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)
+	o->op_private |= OPpPAD_STATE;
     return o;
 }
 
@@ -1807,48 +1875,50 @@ Perl_bind_match(pTHX_ I32 type, OP *left, OP *right)
 {
     OP *o;
     bool ismatchop = 0;
+    const OPCODE ltype = left->op_type;
+    const OPCODE rtype = right->op_type;
 
-    if ( (left->op_type == OP_RV2AV ||
-       left->op_type == OP_RV2HV ||
-       left->op_type == OP_PADAV ||
-       left->op_type == OP_PADHV)
-       && ckWARN(WARN_MISC))
+    if ( (ltype == OP_RV2AV || ltype == OP_RV2HV || ltype == OP_PADAV
+	  || ltype == OP_PADHV) && ckWARN(WARN_MISC))
     {
-      const char * const desc = PL_op_desc[(right->op_type == OP_SUBST ||
-                            right->op_type == OP_TRANS)
-                           ? right->op_type : OP_MATCH];
-      const char * const sample = ((left->op_type == OP_RV2AV ||
-			     left->op_type == OP_PADAV)
-			    ? "@array" : "%hash");
+      const char * const desc
+	  = PL_op_desc[(rtype == OP_SUBST || rtype == OP_TRANS)
+	     ? rtype : OP_MATCH];
+      const char * const sample = ((ltype == OP_RV2AV || ltype == OP_PADAV)
+	     ? "@array" : "%hash");
       Perl_warner(aTHX_ packWARN(WARN_MISC),
              "Applying %s to %s will act on scalar(%s)",
              desc, sample, sample);
     }
 
-    if (right->op_type == OP_CONST &&
+    if (rtype == OP_CONST &&
 	cSVOPx(right)->op_private & OPpCONST_BARE &&
 	cSVOPx(right)->op_private & OPpCONST_STRICT)
     {
 	no_bareword_allowed(right);
     }
 
-    ismatchop = right->op_type == OP_MATCH ||
-		right->op_type == OP_SUBST ||
-		right->op_type == OP_TRANS;
+    ismatchop = rtype == OP_MATCH ||
+		rtype == OP_SUBST ||
+		rtype == OP_TRANS;
     if (ismatchop && right->op_private & OPpTARGET_MY) {
 	right->op_targ = 0;
 	right->op_private &= ~OPpTARGET_MY;
     }
     if (!(right->op_flags & OPf_STACKED) && ismatchop) {
+	OP *newleft;
+
 	right->op_flags |= OPf_STACKED;
-	if (right->op_type != OP_MATCH &&
-            ! (right->op_type == OP_TRANS &&
+	if (rtype != OP_MATCH &&
+            ! (rtype == OP_TRANS &&
                right->op_private & OPpTRANS_IDENTICAL))
-	    left = mod(left, right->op_type);
+	    newleft = mod(left, rtype);
+	else
+	    newleft = left;
 	if (right->op_type == OP_TRANS)
-	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(left), right);
+	    o = newBINOP(OP_NULL, OPf_STACKED, scalar(newleft), right);
 	else
-	    o = prepend_elem(right->op_type, scalar(left), right);
+	    o = prepend_elem(rtype, scalar(newleft), right);
 	if (type == OP_NOT)
 	    return newUNOP(OP_NOT, 0, scalar(o));
 	return o;
@@ -1862,8 +1932,7 @@ OP *
 Perl_invert(pTHX_ OP *o)
 {
     if (!o)
-	return o;
-    /* XXX need to optimize away NOT NOT here?  Or do we let optimizer do it? */
+	return NULL;
     return newUNOP(OP_NOT, OPf_SPECIAL, scalar(o));
 }
 
@@ -1897,7 +1966,7 @@ Perl_scope(pTHX_ OP *o)
     }
     return o;
 }
-
+	
 int
 Perl_block_start(pTHX_ int full)
 {
@@ -1906,11 +1975,8 @@ Perl_block_start(pTHX_ int full)
     pad_block_start(full);
     SAVEHINTS();
     PL_hints &= ~HINT_BLOCK_SCOPE;
-    SAVESPTR(PL_compiling.cop_warnings);
-    if (! specialWARN(PL_compiling.cop_warnings)) {
-        PL_compiling.cop_warnings = newSVsv(PL_compiling.cop_warnings) ;
-        SAVEFREESV(PL_compiling.cop_warnings) ;
-    }
+    SAVECOMPILEWARNINGS();
+    PL_compiling.cop_warnings = DUP_WARNINGS(PL_compiling.cop_warnings);
     SAVESPTR(PL_compiling.cop_io);
     if (! specialCopIO(PL_compiling.cop_io)) {
         PL_compiling.cop_io = newSVsv(PL_compiling.cop_io) ;
@@ -1926,7 +1992,7 @@ Perl_block_end(pTHX_ I32 floor, OP *seq)
     const int needblockscope = PL_hints & HINT_BLOCK_SCOPE;
     OP* const retval = scalarseq(seq);
     LEAVE_SCOPE(floor);
-    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    CopHINTS_set(&PL_compiling, PL_hints);
     if (needblockscope)
 	PL_hints |= HINT_BLOCK_SCOPE; /* propagate out */
     pad_leavemy();
@@ -1937,7 +2003,7 @@ STATIC OP *
 S_newDEFSVOP(pTHX)
 {
     dVAR;
-    const I32 offset = pad_findmy("$_");
+    const PADOFFSET offset = pad_findmy("$_");
     if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
 	return newSVREF(newGVOP(OP_GV, 0, PL_defgv));
     }
@@ -2004,7 +2070,7 @@ Perl_localize(pTHX_ OP *o, I32 lex)
 #if 0
 	list(o);
 #else
-	/*EMPTY*/;
+	NOOP;
 #endif
     else {
 	if ( PL_bufptr > PL_oldbufptr && PL_bufptr[-1] == ','
@@ -2033,7 +2099,7 @@ 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" : "my")
+				lex ? (PL_in_my == KEY_our ? "our" : PL_in_my == KEY_state ? "state" : "my")
 				: "local");
 	    }
 	}
@@ -2052,8 +2118,7 @@ Perl_jmaybe(pTHX_ OP *o)
 {
     if (o->op_type == OP_LIST) {
 	OP * const o2
-	    = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL,
-						     SVt_PV)));
+	    = newSVREF(newGVOP(OP_GV, 0, gv_fetchpvs(";", GV_ADD|GV_NOTQUAL, SVt_PV)));
 	o = convert(OP_JOIN, 0, prepend_elem(OP_LIST, o2, o));
     }
     return o;
@@ -2064,8 +2129,15 @@ Perl_fold_constants(pTHX_ register OP *o)
 {
     dVAR;
     register OP *curop;
+    OP *newop;
     I32 type = o->op_type;
-    SV *sv;
+    SV *sv = NULL;
+    int ret = 0;
+    I32 oldscope;
+    OP *old_next;
+    SV * const oldwarnhook = PL_warnhook;
+    SV * const olddiehook  = PL_diehook;
+    dJMPENV;
 
     if (PL_opargs[type] & OA_RETSCALAR)
 	scalar(o);
@@ -2107,34 +2179,77 @@ Perl_fold_constants(pTHX_ register OP *o)
 	goto nope;		/* Don't try to run w/ errors */
 
     for (curop = LINKLIST(o); curop != o; curop = LINKLIST(curop)) {
-	if ((curop->op_type != OP_CONST ||
-	     (curop->op_private & OPpCONST_BARE)) &&
-	    curop->op_type != OP_LIST &&
-	    curop->op_type != OP_SCALAR &&
-	    curop->op_type != OP_NULL &&
-	    curop->op_type != OP_PUSHMARK)
+	const OPCODE type = curop->op_type;
+	if ((type != OP_CONST || (curop->op_private & OPpCONST_BARE)) &&
+	    type != OP_LIST &&
+	    type != OP_SCALAR &&
+	    type != OP_NULL &&
+	    type != OP_PUSHMARK)
 	{
 	    goto nope;
 	}
     }
 
     curop = LINKLIST(o);
+    old_next = o->op_next;
     o->op_next = 0;
     PL_op = curop;
-    CALLRUNOPS(aTHX);
-    sv = *(PL_stack_sp--);
-    if (o->op_targ && sv == PAD_SV(o->op_targ))	/* grab pad temp? */
-	pad_swipe(o->op_targ,  FALSE);
-    else if (SvTEMP(sv)) {			/* grab mortal temp? */
-	SvREFCNT_inc_simple_void(sv);
-	SvTEMP_off(sv);
-    }
+
+    oldscope = PL_scopestack_ix;
+    create_eval_scope(G_FAKINGEVAL);
+
+    PL_warnhook = PERL_WARNHOOK_FATAL;
+    PL_diehook  = NULL;
+    JMPENV_PUSH(ret);
+
+    switch (ret) {
+    case 0:
+	CALLRUNOPS(aTHX);
+	sv = *(PL_stack_sp--);
+	if (o->op_targ && sv == PAD_SV(o->op_targ))	/* grab pad temp? */
+	    pad_swipe(o->op_targ,  FALSE);
+	else if (SvTEMP(sv)) {			/* grab mortal temp? */
+	    SvREFCNT_inc_simple_void(sv);
+	    SvTEMP_off(sv);
+	}
+	break;
+    case 3:
+	/* Something tried to die.  Abandon constant folding.  */
+	/* Pretend the error never happened.  */
+	sv_setpvn(ERRSV,"",0);
+	o->op_next = old_next;
+	break;
+    default:
+	JMPENV_POP;
+	/* Don't expect 1 (setjmp failed) or 2 (something called my_exit)  */
+	PL_warnhook = oldwarnhook;
+	PL_diehook  = olddiehook;
+	/* XXX note that this croak may fail as we've already blown away
+	 * the stack - eg any nested evals */
+	Perl_croak(aTHX_ "panic: fold_constants JMPENV_PUSH returned %d", ret);
+    }
+    JMPENV_POP;
+    PL_warnhook = oldwarnhook;
+    PL_diehook  = olddiehook;
+
+    if (PL_scopestack_ix > oldscope)
+	delete_eval_scope();
+
+    if (ret)
+	goto nope;
+
+#ifndef PERL_MAD
     op_free(o);
+#endif
+    assert(sv);
     if (type == OP_RV2GV)
-	return newGVOP(OP_GV, 0, (GV*)sv);
-    return newSVOP(OP_CONST, 0, sv);
+	newop = newGVOP(OP_GV, 0, (GV*)sv);
+    else
+	newop = newSVOP(OP_CONST, 0, sv);
+    op_getmad(o,newop,'f');
+    return newop;
 
-  nope:
+ nope:
     return o;
 }
 
@@ -2165,7 +2280,11 @@ Perl_gen_constant_list(pTHX_ register OP *o)
     o->op_opt = 0;		/* needs to be revisited in peep() */
     curop = ((UNOP*)o)->op_first;
     ((UNOP*)o)->op_first = newSVOP(OP_CONST, 0, SvREFCNT_inc_NN(*PL_stack_sp--));
+#ifdef PERL_MAD
+    op_getmad(curop,o,'O');
+#else
     op_free(curop);
+#endif
     linklist(o);
     return list(o);
 }
@@ -2239,6 +2358,22 @@ Perl_append_list(pTHX_ I32 type, LISTOP *first, LISTOP *last)
     first->op_last = last->op_last;
     first->op_flags |= (last->op_flags & OPf_KIDS);
 
+#ifdef PERL_MAD
+    if (last->op_first && first->op_madprop) {
+	MADPROP *mp = last->op_first->op_madprop;
+	if (mp) {
+	    while (mp->mad_next)
+		mp = mp->mad_next;
+	    mp->mad_next = first->op_madprop;
+	}
+	else {
+	    last->op_first->op_madprop = first->op_madprop;
+	}
+    }
+    first->op_madprop = last->op_madprop;
+    last->op_madprop = 0;
+#endif
+
     FreeOp(last);
 
     return (OP*)first;
@@ -2277,6 +2412,246 @@ Perl_prepend_elem(pTHX_ I32 type, OP *first, OP *last)
 
 /* Constructors */
 
+#ifdef PERL_MAD
+ 
+TOKEN *
+Perl_newTOKEN(pTHX_ I32 optype, YYSTYPE lval, MADPROP* madprop)
+{
+    TOKEN *tk;
+    Newxz(tk, 1, TOKEN);
+    tk->tk_type = (OPCODE)optype;
+    tk->tk_type = 12345;
+    tk->tk_lval = lval;
+    tk->tk_mad = madprop;
+    return tk;
+}
+
+void
+Perl_token_free(pTHX_ TOKEN* tk)
+{
+    if (tk->tk_type != 12345)
+	return;
+    mad_free(tk->tk_mad);
+    Safefree(tk);
+}
+
+void
+Perl_token_getmad(pTHX_ TOKEN* tk, OP* o, char slot)
+{
+    MADPROP* mp;
+    MADPROP* tm;
+    if (tk->tk_type != 12345) {
+	Perl_warner(aTHX_ packWARN(WARN_MISC),
+	     "Invalid TOKEN object ignored");
+	return;
+    }
+    tm = tk->tk_mad;
+    if (!tm)
+	return;
+
+    /* faked up qw list? */
+    if (slot == '(' &&
+	tm->mad_type == MAD_SV &&
+	SvPVX((SV*)tm->mad_val)[0] == 'q')
+	    slot = 'x';
+
+    if (o) {
+	mp = o->op_madprop;
+	if (mp) {
+	    for (;;) {
+		/* pretend constant fold didn't happen? */
+		if (mp->mad_key == 'f' &&
+		    (o->op_type == OP_CONST ||
+		     o->op_type == OP_GV) )
+		{
+		    token_getmad(tk,(OP*)mp->mad_val,slot);
+		    return;
+		}
+		if (!mp->mad_next)
+		    break;
+		mp = mp->mad_next;
+	    }
+	    mp->mad_next = tm;
+	    mp = mp->mad_next;
+	}
+	else {
+	    o->op_madprop = tm;
+	    mp = o->op_madprop;
+	}
+	if (mp->mad_key == 'X')
+	    mp->mad_key = slot;	/* just change the first one */
+
+	tk->tk_mad = 0;
+    }
+    else
+	mad_free(tm);
+    Safefree(tk);
+}
+
+void
+Perl_op_getmad_weak(pTHX_ OP* from, OP* o, char slot)
+{
+    MADPROP* mp;
+    if (!from)
+	return;
+    if (o) {
+	mp = o->op_madprop;
+	if (mp) {
+	    for (;;) {
+		/* pretend constant fold didn't happen? */
+		if (mp->mad_key == 'f' &&
+		    (o->op_type == OP_CONST ||
+		     o->op_type == OP_GV) )
+		{
+		    op_getmad(from,(OP*)mp->mad_val,slot);
+		    return;
+		}
+		if (!mp->mad_next)
+		    break;
+		mp = mp->mad_next;
+	    }
+	    mp->mad_next = newMADPROP(slot,MAD_OP,from,0);
+	}
+	else {
+	    o->op_madprop = newMADPROP(slot,MAD_OP,from,0);
+	}
+    }
+}
+
+void
+Perl_op_getmad(pTHX_ OP* from, OP* o, char slot)
+{
+    MADPROP* mp;
+    if (!from)
+	return;
+    if (o) {
+	mp = o->op_madprop;
+	if (mp) {
+	    for (;;) {
+		/* pretend constant fold didn't happen? */
+		if (mp->mad_key == 'f' &&
+		    (o->op_type == OP_CONST ||
+		     o->op_type == OP_GV) )
+		{
+		    op_getmad(from,(OP*)mp->mad_val,slot);
+		    return;
+		}
+		if (!mp->mad_next)
+		    break;
+		mp = mp->mad_next;
+	    }
+	    mp->mad_next = newMADPROP(slot,MAD_OP,from,1);
+	}
+	else {
+	    o->op_madprop = newMADPROP(slot,MAD_OP,from,1);
+	}
+    }
+    else {
+	PerlIO_printf(PerlIO_stderr(),
+		      "DESTROYING op = %0"UVxf"\n", PTR2UV(from));
+	op_free(from);
+    }
+}
+
+void
+Perl_prepend_madprops(pTHX_ MADPROP* mp, OP* o, char slot)
+{
+    MADPROP* tm;
+    if (!mp || !o)
+	return;
+    if (slot)
+	mp->mad_key = slot;
+    tm = o->op_madprop;
+    o->op_madprop = mp;
+    for (;;) {
+	if (!mp->mad_next)
+	    break;
+	mp = mp->mad_next;
+    }
+    mp->mad_next = tm;
+}
+
+void
+Perl_append_madprops(pTHX_ MADPROP* tm, OP* o, char slot)
+{
+    if (!o)
+	return;
+    addmad(tm, &(o->op_madprop), slot);
+}
+
+void
+Perl_addmad(pTHX_ MADPROP* tm, MADPROP** root, char slot)
+{
+    MADPROP* mp;
+    if (!tm || !root)
+	return;
+    if (slot)
+	tm->mad_key = slot;
+    mp = *root;
+    if (!mp) {
+	*root = tm;
+	return;
+    }
+    for (;;) {
+	if (!mp->mad_next)
+	    break;
+	mp = mp->mad_next;
+    }
+    mp->mad_next = tm;
+}
+
+MADPROP *
+Perl_newMADsv(pTHX_ char key, SV* sv)
+{
+    return newMADPROP(key, MAD_SV, sv, 0);
+}
+
+MADPROP *
+Perl_newMADPROP(pTHX_ char key, char type, void* val, I32 vlen)
+{
+    MADPROP *mp;
+    Newxz(mp, 1, MADPROP);
+    mp->mad_next = 0;
+    mp->mad_key = key;
+    mp->mad_vlen = vlen;
+    mp->mad_type = type;
+    mp->mad_val = val;
+/*    PerlIO_printf(PerlIO_stderr(), "NEW  mp = %0x\n", mp);  */
+    return mp;
+}
+
+void
+Perl_mad_free(pTHX_ MADPROP* mp)
+{
+/*    PerlIO_printf(PerlIO_stderr(), "FREE mp = %0x\n", mp); */
+    if (!mp)
+	return;
+    if (mp->mad_next)
+	mad_free(mp->mad_next);
+/*    if (PL_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:
+	break;
+    case MAD_PV:
+	Safefree((char*)mp->mad_val);
+	break;
+    case MAD_OP:
+	if (mp->mad_vlen)	/* vlen holds "strong/weak" boolean */
+	    op_free((OP*)mp->mad_val);
+	break;
+    case MAD_SV:
+	sv_free((SV*)mp->mad_val);
+	break;
+    default:
+	PerlIO_printf(PerlIO_stderr(), "Unrecognized mad\n");
+	break;
+    }
+    Safefree(mp);
+}
+
+#endif
+
 OP *
 Perl_newNULLLIST(pTHX)
 {
@@ -2466,6 +2841,7 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	const I32 to_utf    = o->op_private & OPpTRANS_TO_UTF;
 	U8* tsave = NULL;
 	U8* rsave = NULL;
+	const U32 flags = UTF8_ALLOW_DEFAULT;
 
 	if (!from_utf) {
 	    STRLEN len = tlen;
@@ -2492,11 +2868,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	    i = 0;
 	    transv = newSVpvs("");
 	    while (t < tend) {
-		cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+		cp[2*i] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
 		t += ulen;
 		if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {
 		    t++;
-		    cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, 0);
+		    cp[2*i+1] = utf8n_to_uvuni(t, tend-t, &ulen, flags);
 		    t += ulen;
 		}
 		else {
@@ -2550,11 +2926,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	while (t < tend || tfirst <= tlast) {
 	    /* see if we need more "t" chars */
 	    if (tfirst > tlast) {
-		tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+		tfirst = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
 		t += ulen;
 		if (t < tend && NATIVE_TO_UTF(*t) == 0xff) {	/* illegal utf8 val indicates range */
 		    t++;
-		    tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, 0);
+		    tlast = (I32)utf8n_to_uvuni(t, tend - t, &ulen, flags);
 		    t += ulen;
 		}
 		else
@@ -2564,11 +2940,11 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	    /* now see if we need more "r" chars */
 	    if (rfirst > rlast) {
 		if (r < rend) {
-		    rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+		    rfirst = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
 		    r += ulen;
 		    if (r < rend && NATIVE_TO_UTF(*r) == 0xff) {	/* illegal utf8 val indicates range */
 			r++;
-			rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, 0);
+			rlast = (I32)utf8n_to_uvuni(r, rend - r, &ulen, flags);
 			r += ulen;
 		    }
 		    else
@@ -2643,8 +3019,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
 	Safefree(tsave);
 	Safefree(rsave);
 
+#ifdef PERL_MAD
+	op_getmad(expr,o,'e');
+	op_getmad(repl,o,'r');
+#else
 	op_free(expr);
 	op_free(repl);
+#endif
 	return o;
     }
 
@@ -2714,8 +3095,13 @@ Perl_pmtrans(pTHX_ OP *o, OP *expr, OP *repl)
     }
     if (grows)
 	o->op_private |= OPpTRANS_GROWS;
+#ifdef PERL_MAD
+    op_getmad(expr,o,'e');
+    op_getmad(repl,o,'r');
+#else
     op_free(expr);
     op_free(repl);
+#endif
 
     return o;
 }
@@ -2852,7 +3238,11 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 	PM_SETRE(pm, CALLREGCOMP(aTHX_ (char*)p, (char*)p + plen, pm));
 	if (strEQ("\\s+", PM_GETRE(pm)->precomp))
 	    pm->op_pmflags |= PMf_WHITE;
+#ifdef PERL_MAD
+	op_getmad(expr,(OP*)pm,'e');
+#else
 	op_free(expr);
+#endif
     }
     else {
 	if (pm->op_pmflags & PMf_KEEP || !(PL_hints & HINT_RE_EVAL))
@@ -2924,7 +3314,7 @@ Perl_pmruntime(pTHX_ OP *o, OP *expr, bool isreg)
 			repl_has_vars = 1;
 		    }
 		    else if (curop->op_type == OP_PUSHRE)
-			/*EMPTY*/; /* Okay here, dangerous in newASSIGNOP */
+			NOOP; /* Okay here, dangerous in newASSIGNOP */
 		    else
 			break;
 		}
@@ -3036,12 +3426,19 @@ Perl_newPVOP(pTHX_ I32 type, I32 flags, char *pv)
     return CHECKOP(type, pvop);
 }
 
+#ifdef PERL_MAD
+OP*
+#else
 void
+#endif
 Perl_package(pTHX_ OP *o)
 {
     dVAR;
     const char *name;
     STRLEN len;
+#ifdef PERL_MAD
+    OP *pegop;
+#endif
 
     save_hptr(&PL_curstash);
     save_item(PL_curstname);
@@ -3049,29 +3446,53 @@ Perl_package(pTHX_ OP *o)
     name = SvPV_const(cSVOPo->op_sv, len);
     PL_curstash = gv_stashpvn(name, len, TRUE);
     sv_setpvn(PL_curstname, name, len);
-    op_free(o);
 
     PL_hints |= HINT_BLOCK_SCOPE;
     PL_copline = NOLINE;
     PL_expect = XSTATE;
+
+#ifndef PERL_MAD
+    op_free(o);
+#else
+    if (!PL_madskills) {
+	op_free(o);
+	return NULL;
+    }
+
+    pegop = newOP(OP_NULL,0);
+    op_getmad(o,pegop,'P');
+    return pegop;
+#endif
 }
 
+#ifdef PERL_MAD
+OP*
+#else
 void
+#endif
 Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
 {
     dVAR;
     OP *pack;
     OP *imop;
     OP *veop;
+#ifdef PERL_MAD
+    OP *pegop = newOP(OP_NULL,0);
+#endif
 
     if (idop->op_type != OP_CONST)
 	Perl_croak(aTHX_ "Module name must be constant");
 
+    if (PL_madskills)
+	op_getmad(idop,pegop,'U');
+
     veop = NULL;
 
     if (version) {
 	SV * const vesv = ((SVOP*)version)->op_sv;
 
+	if (PL_madskills)
+	    op_getmad(version,pegop,'V');
 	if (!arg && !SvNIOKp(vesv)) {
 	    arg = version;
 	}
@@ -3095,8 +3516,11 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
     }
 
     /* Fake up an import/unimport */
-    if (arg && arg->op_type == OP_STUB)
+    if (arg && arg->op_type == OP_STUB) {
+	if (PL_madskills)
+	    op_getmad(arg,pegop,'S');
 	imop = arg;		/* no import on explicit () */
+    }
     else if (SvNIOKp(((SVOP*)idop)->op_sv)) {
 	imop = NULL;		/* use 5.0; */
 	if (!aver)
@@ -3105,6 +3529,9 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
     else {
 	SV *meth;
 
+	if (PL_madskills)
+	    op_getmad(arg,pegop,'A');
+
 	/* Make copy of idop so we don't free it twice */
 	pack = newSVOP(OP_CONST, 0, newSVsv(((SVOP*)idop)->op_sv));
 
@@ -3149,6 +3576,15 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg)
     PL_copline = NOLINE;
     PL_expect = XSTATE;
     PL_cop_seqmax++; /* Purely for B::*'s benefit */
+
+#ifdef PERL_MAD
+    if (!PL_madskills) {
+	/* FIXME - don't allocate pegop if !PL_madskills */
+	op_free(pegop);
+	return NULL;
+    }
+    return pegop;
+#endif
 }
 
 /*
@@ -3248,8 +3684,7 @@ Perl_dofile(pTHX_ OP *term, I32 force_builtin)
 	doop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
 			       append_elem(OP_LIST, term,
 					   scalar(newUNOP(OP_RV2CV, 0,
-							  newGVOP(OP_GV, 0,
-								  gv))))));
+							  newGVOP(OP_GV, 0, gv))))));
     }
     else {
 	doop = newUNOP(OP_DOFILE, 0, scalar(term));
@@ -3268,13 +3703,18 @@ Perl_newSLICEOP(pTHX_ I32 flags, OP *subscript, OP *listval)
 STATIC I32
 S_is_list_assignment(pTHX_ register const OP *o)
 {
+    unsigned type;
+    U8 flags;
+
     if (!o)
 	return TRUE;
 
-    if (o->op_type == OP_NULL && o->op_flags & OPf_KIDS)
+    if ((o->op_type == OP_NULL) && (o->op_flags & OPf_KIDS))
 	o = cUNOPo->op_first;
 
-    if (o->op_type == OP_COND_EXPR) {
+    flags = o->op_flags;
+    type = o->op_type;
+    if (type == OP_COND_EXPR) {
         const I32 t = is_list_assignment(cLOGOPo->op_first->op_sibling);
         const I32 f = is_list_assignment(cLOGOPo->op_first->op_sibling->op_sibling);
 
@@ -3285,20 +3725,20 @@ S_is_list_assignment(pTHX_ register const OP *o)
 	return FALSE;
     }
 
-    if (o->op_type == OP_LIST &&
-	(o->op_flags & OPf_WANT) == OPf_WANT_SCALAR &&
+    if (type == OP_LIST &&
+	(flags & OPf_WANT) == OPf_WANT_SCALAR &&
 	o->op_private & OPpLVAL_INTRO)
 	return FALSE;
 
-    if (o->op_type == OP_LIST || o->op_flags & OPf_PARENS ||
-	o->op_type == OP_RV2AV || o->op_type == OP_RV2HV ||
-	o->op_type == OP_ASLICE || o->op_type == OP_HSLICE)
+    if (type == OP_LIST || flags & OPf_PARENS ||
+	type == OP_RV2AV || type == OP_RV2HV ||
+	type == OP_ASLICE || type == OP_HSLICE)
 	return TRUE;
 
-    if (o->op_type == OP_PADAV || o->op_type == OP_PADHV)
+    if (type == OP_PADAV || type == OP_PADHV)
 	return TRUE;
 
-    if (o->op_type == OP_RV2SV)
+    if (type == OP_RV2SV)
 	return FALSE;
 
     return FALSE;
@@ -3333,6 +3773,7 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	if (PL_eval_start)
 	    PL_eval_start = 0;
 	else if (left->op_type == OP_CONST) {
+	    /* FIXME for MAD */
 	    /* Result of assignment is always 1 (or we'd be dead already) */
 	    return newSVOP(OP_CONST, 0, newSViv(1));
 	}
@@ -3410,10 +3851,8 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 		o->op_private |= OPpASSIGN_COMMON;
 	}
 	if (right && right->op_type == OP_SPLIT) {
-	    OP* tmpop;
-	    if ((tmpop = ((LISTOP*)right)->op_first) &&
-		tmpop->op_type == OP_PUSHRE)
-	    {
+	    OP* tmpop = ((LISTOP*)right)->op_first;
+	    if (tmpop && (tmpop->op_type == OP_PUSHRE)) {
 		PMOP * const pm = (PMOP*)tmpop;
 		if (left->op_type == OP_RV2AV &&
 		    !(left->op_private & OPpLVAL_INTRO) &&
@@ -3433,7 +3872,11 @@ 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;
@@ -3465,7 +3908,10 @@ Perl_newASSIGNOP(pTHX_ I32 flags, OP *left, I32 optype, OP *right)
 	if (PL_eval_start)
 	    PL_eval_start = 0;
 	else {
-	    o = newSVOP(OP_CONST, 0, newSViv(PL_compiling.cop_arybase));
+	    /* FIXME for MAD */
+	    op_free(o);
+	    o = newSVOP(OP_CONST, 0, newSViv(CopARYBASE_get(&PL_compiling)));
+	    o->op_private |= OPpCONST_ARYBASE;
 	}
     }
     return o;
@@ -3488,11 +3934,11 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	cop->op_ppaddr = PL_ppaddr[ OP_NEXTSTATE ];
     }
     cop->op_flags = (U8)flags;
-    cop->op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+    CopHINTS_set(cop, PL_hints);
 #ifdef NATIVE_HINTS
     cop->op_private |= NATIVE_HINTS;
 #endif
-    PL_compiling.op_private = cop->op_private;
+    CopHINTS_set(&PL_compiling, CopHINTS_get(cop));
     cop->op_next = (OP*)cop;
 
     if (label) {
@@ -3500,16 +3946,18 @@ Perl_newSTATEOP(pTHX_ I32 flags, char *label, OP *o)
 	PL_hints |= HINT_BLOCK_SCOPE;
     }
     cop->cop_seq = seq;
-    cop->cop_arybase = PL_curcop->cop_arybase;
-    if (specialWARN(PL_curcop->cop_warnings))
-        cop->cop_warnings = PL_curcop->cop_warnings ;
-    else
-        cop->cop_warnings = newSVsv(PL_curcop->cop_warnings) ;
+    CopARYBASE_set(cop, CopARYBASE_get(PL_curcop));
+    cop->cop_warnings = DUP_WARNINGS(PL_curcop->cop_warnings);
     if (specialCopIO(PL_curcop->cop_io))
         cop->cop_io = PL_curcop->cop_io;
     else
         cop->cop_io = newSVsv(PL_curcop->cop_io) ;
-
+    cop->cop_hints = PL_curcop->cop_hints;
+    if (cop->cop_hints) {
+	HINTS_REFCNT_LOCK;
+	cop->cop_hints->refcounted_he_refcnt++;
+	HINTS_REFCNT_UNLOCK;
+    }
 
     if (PL_copline == NOLINE)
         CopLINE_set(cop, CopLINE(PL_curcop));
@@ -3557,7 +4005,9 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 
     scalarboolean(first);
     /* optimize "!a && b" to "a || b", and "!a || b" to "a && b" */
-    if (first->op_type == OP_NOT && (first->op_flags & OPf_SPECIAL)) {
+    if (first->op_type == OP_NOT
+	&& (first->op_flags & OPf_SPECIAL)
+	&& (first->op_flags & OPf_KIDS)) {
 	if (type == OP_AND || type == OP_OR) {
 	    if (type == OP_AND)
 		type = OP_OR;
@@ -3568,7 +4018,11 @@ 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) {
@@ -3579,10 +4033,16 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 	if ((type == OP_AND &&  SvTRUE(((SVOP*)first)->op_sv)) ||
 	    (type == OP_OR  && !SvTRUE(((SVOP*)first)->op_sv)) ||
 	    (type == OP_DOR && !SvOK(((SVOP*)first)->op_sv))) {
-	    op_free(first);
 	    *firstp = NULL;
 	    if (other->op_type == OP_CONST)
 		other->op_private |= OPpCONST_SHORTCIRCUIT;
+	    if (PL_madskills) {
+		OP *newop = newUNOP(OP_NULL, 0, other);
+		op_getmad(first, newop, '1');
+		newop->op_targ = type;	/* set "was" field */
+		return newop;
+	    }
+	    op_free(first);
 	    return other;
 	}
 	else {
@@ -3603,10 +4063,16 @@ S_new_logop(pTHX_ I32 type, I32 flags, OP** firstp, OP** otherp)
 			    "Deprecated use of my() in false conditional");
 	    }
 
-	    op_free(other);
 	    *otherp = NULL;
 	    if (first->op_type == OP_CONST)
 		first->op_private |= OPpCONST_SHORTCIRCUIT;
+	    if (PL_madskills) {
+		first = newUNOP(OP_NULL, 0, first);
+		op_getmad(other, first, '2');
+		first->op_targ = type;	/* set "was" field */
+	    }
+	    else
+		op_free(other);
 	    return first;
 	}
     }
@@ -3698,13 +4164,31 @@ Perl_newCONDOP(pTHX_ I32 flags, OP *first, OP *trueop, OP *falseop)
 	    no_bareword_allowed(first);
 	}
 	if (SvTRUE(((SVOP*)first)->op_sv)) {
+#ifdef PERL_MAD
+	    if (PL_madskills) {
+		trueop = newUNOP(OP_NULL, 0, trueop);
+		op_getmad(first,trueop,'C');
+		op_getmad(falseop,trueop,'e');
+	    }
+	    /* FIXME for MAD - should there be an ELSE here?  */
+#else
 	    op_free(first);
 	    op_free(falseop);
+#endif
 	    return trueop;
 	}
 	else {
+#ifdef PERL_MAD
+	    if (PL_madskills) {
+		falseop = newUNOP(OP_NULL, 0, falseop);
+		op_getmad(first,falseop,'C');
+		op_getmad(trueop,falseop,'t');
+	    }
+	    /* FIXME for MAD - should there be an ELSE here?  */
+#else
 	    op_free(first);
 	    op_free(trueop);
+#endif
 	    return falseop;
 	}
     }
@@ -3811,10 +4295,10 @@ Perl_newLOOPOP(pTHX_ I32 flags, I32 debuggable, OP *expr, OP *block)
 		break;
 
 	      case OP_SASSIGN:
-		if (k1->op_type == OP_READDIR
+		if (k1 && (k1->op_type == OP_READDIR
 		      || k1->op_type == OP_GLOB
 		      || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
-		      || k1->op_type == OP_EACH)
+		      || k1->op_type == OP_EACH))
 		    expr = newUNOP(OP_DEFINED, 0, expr);
 		break;
 	    }
@@ -3873,10 +4357,10 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
 		break;
 
 	      case OP_SASSIGN:
-		if (k1->op_type == OP_READDIR
+		if (k1 && (k1->op_type == OP_READDIR
 		      || k1->op_type == OP_GLOB
 		      || (k1->op_type == OP_NULL && k1->op_targ == OP_GLOB)
-		      || k1->op_type == OP_EACH)
+		      || k1->op_type == OP_EACH))
 		    expr = newUNOP(OP_DEFINED, 0, expr);
 		break;
 	    }
@@ -3899,7 +4383,9 @@ whileline, OP *expr, OP *block, OP *cont, I32 has_my)
 	cont = append_elem(OP_LINESEQ, cont, unstack);
     }
 
+    assert(block);
     listop = append_list(OP_LINESEQ, (LISTOP*)block, (LISTOP*)cont);
+    assert(listop);
     redo = LINKLIST(listop);
 
     if (expr) {
@@ -3951,6 +4437,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
     PADOFFSET padoff = 0;
     I32 iterflags = 0;
     I32 iterpflags = 0;
+    OP *madsv = NULL;
 
     if (sv) {
 	if (sv->op_type == OP_RV2SV) {	/* symbol table variable */
@@ -3963,15 +4450,23 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
 	else if (sv->op_type == OP_PADSV) { /* private variable */
 	    iterpflags = sv->op_private & OPpLVAL_INTRO; /* for my $x () */
 	    padoff = sv->op_targ;
-	    sv->op_targ = 0;
-	    op_free(sv);
+	    if (PL_madskills)
+		madsv = sv;
+	    else {
+		sv->op_targ = 0;
+		op_free(sv);
+	    }
 	    sv = NULL;
 	}
 	else if (sv->op_type == OP_THREADSV) { /* per-thread variable */
 	    padoff = sv->op_targ;
-	    sv->op_targ = 0;
-	    iterflags |= OPf_SPECIAL;
-	    op_free(sv);
+	    if (PL_madskills)
+		madsv = sv;
+	    else {
+		sv->op_targ = 0;
+		iterflags |= OPf_SPECIAL;
+		op_free(sv);
+	    }
 	    sv = NULL;
 	}
 	else
@@ -3980,7 +4475,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
 	    iterpflags |= OPpITER_DEF;
     }
     else {
-        const I32 offset = pad_findmy("$_");
+        const PADOFFSET offset = pad_findmy("$_");
 	if (offset == NOT_IN_PAD || PAD_COMPNAME_FLAGS_isOUR(offset)) {
 	    sv = newGVOP(OP_GV, 0, PL_defgv);
 	}
@@ -4001,7 +4496,7 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
 	 * set the STACKED flag to indicate that these values are to be
 	 * treated as min/max values by 'pp_iterinit'.
 	 */
-	UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
+	const UNOP* const flip = (UNOP*)((UNOP*)((BINOP*)expr)->op_first)->op_first;
 	LOGOP* const range = (LOGOP*) flip->op_first;
 	OP* const left  = range->op_first;
 	OP* const right = left->op_sibling;
@@ -4016,7 +4511,11 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
 	right->op_next = (OP*)listop;
 	listop->op_next = listop->op_first;
 
+#ifdef PERL_MAD
+	op_getmad(expr,(OP*)listop,'O');
+#else
 	op_free(expr);
+#endif
 	expr = (OP*)(listop);
         op_null(expr);
 	iterflags |= OPf_STACKED;
@@ -4040,10 +4539,12 @@ Perl_newFOROP(pTHX_ I32 flags, char *label, line_t forline, OP *sv, OP *expr, OP
 	loop = tmp;
     }
 #else
-    Renew(loop, 1, LOOP);
+    loop = PerlMemShared_realloc(loop, sizeof(LOOP));
 #endif
     loop->op_targ = padoff;
     wop = newWHILEOP(flags, 1, loop, forline, newOP(OP_ITER, 0), block, cont, 0);
+    if (madsv)
+	op_getmad(madsv, (OP*)loop, 'v');
     PL_copline = forline;
     return newSTATEOP(0, label, wop);
 }
@@ -4063,7 +4564,11 @@ Perl_newLOOPEX(pTHX_ I32 type, OP *label)
 					? SvPVx_nolen_const(((SVOP*)label)->op_sv)
 					: ""));
 	}
+#ifdef PERL_MAD
+	op_getmad(label,o,'L');
+#else
 	op_free(label);
+#endif
     }
     else {
 	/* Check whether it's going to be a goto &function */
@@ -4162,7 +4667,7 @@ S_newGIVWHENOP(pTHX_ OP *cond, OP *block,
  */
 STATIC
 bool
-S_looks_like_bool(pTHX_ OP *o)
+S_looks_like_bool(pTHX_ const OP *o)
 {
     dVAR;
     switch(o->op_type) {
@@ -4233,7 +4738,7 @@ Perl_newGIVENOP(pTHX_ OP *cond, OP *block, PADOFFSET defsv_off)
 OP *
 Perl_newWHENOP(pTHX_ OP *cond, OP *block)
 {
-    bool cond_llb = (!cond || looks_like_bool(cond));
+    const bool cond_llb = (!cond || looks_like_bool(cond));
     OP *cond_op;
 
     if (cond_llb)
@@ -4308,9 +4813,15 @@ Perl_cv_undef(pTHX_ CV *cv)
 }
 
 void
-Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
-{
-    if (((!p != !SvPOK(cv)) || (p && strNE(p, SvPVX_const(cv)))) && ckWARN_d(WARN_PROTOTYPE)) {
+Perl_cv_ckproto_len(pTHX_ const CV *cv, const GV *gv, const char *p,
+		    const STRLEN len)
+{
+    /* Can't just use a strcmp on the prototype, as CONSTSUBs "cheat" by
+       relying on SvCUR, and doubling up the buffer to hold CvFILE().  */
+    if (((!p != !SvPOK(cv)) /* One has prototype, one has not.  */
+	 || (p && (len != SvCUR(cv) /* Not the same length.  */
+		   || memNE(p, SvPVX_const(cv), len))))
+	 && ckWARN_d(WARN_PROTOTYPE)) {
 	SV* const msg = sv_newmortal();
 	SV* name = NULL;
 
@@ -4318,17 +4829,17 @@ Perl_cv_ckproto(pTHX_ const CV *cv, const GV *gv, const char *p)
 	    gv_efullname3(name = sv_newmortal(), gv, NULL);
 	sv_setpv(msg, "Prototype mismatch:");
 	if (name)
-	    Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, name);
+	    Perl_sv_catpvf(aTHX_ msg, " sub %"SVf, (void*)name);
 	if (SvPOK(cv))
-	    Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (const SV *)cv);
+	    Perl_sv_catpvf(aTHX_ msg, " (%"SVf")", (void*)cv);
 	else
 	    sv_catpvs(msg, ": none");
 	sv_catpvs(msg, " vs ");
 	if (p)
-	    Perl_sv_catpvf(aTHX_ msg, "(%s)", p);
+	    Perl_sv_catpvf(aTHX_ msg, "(%.*s)", (int) len, p);
 	else
 	    sv_catpvs(msg, "none");
-	Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, msg);
+	Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "%"SVf, (void*)msg);
     }
 }
 
@@ -4436,9 +4947,18 @@ Perl_op_const_sv(pTHX_ const OP *o, CV *cv)
     return sv;
 }
 
+#ifdef PERL_MAD
+OP *
+#else
 void
+#endif
 Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 {
+#if 0
+    /* This would be the return value, but the return cannot be reached.  */
+    OP* pegop = newOP(OP_NULL, 0);
+#endif
+
     PERL_UNUSED_ARG(floor);
 
     if (o)
@@ -4450,6 +4970,9 @@ Perl_newMYSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     if (block)
 	SAVEFREEOP(block);
     Perl_croak(aTHX_ "\"my sub\" not yet implemented");
+#ifdef PERL_MAD
+    NORETURN_FUNCTION_END;
+#endif
 }
 
 CV *
@@ -4474,7 +4997,8 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
        full GV and CV.  If anything is present then it will take a full CV to
        store it.  */
     const I32 gv_fetch_flags
-	= (block || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
+	= (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;
 
@@ -4500,12 +5024,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		     : (PL_curstash ? "__ANON__" : "__ANON__::__ANON__"),
 		     gv_fetch_flags, SVt_PVCV);
 
-    if (o)
-	SAVEFREEOP(o);
-    if (proto)
-	SAVEFREEOP(proto);
-    if (attrs)
-	SAVEFREEOP(attrs);
+    if (!PL_madskills) {
+	if (o)
+	    SAVEFREEOP(o);
+	if (proto)
+	    SAVEFREEOP(proto);
+	if (attrs)
+	    SAVEFREEOP(attrs);
+    }
 
     if (SvTYPE(gv) != SVt_PVGV) {	/* Maybe prototype now, and had at
 					   maximum a prototype before. */
@@ -4515,7 +5041,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    {
 		Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE), "Runaway prototype");
 	    }
-	    cv_ckproto((CV*)gv, NULL, ps);
+	    cv_ckproto_len((CV*)gv, NULL, ps, ps_len);
 	}
 	if (ps)
 	    sv_setpvn((SV*)gv, ps, ps_len);
@@ -4535,7 +5061,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     }
 #endif
 
-    if (!block || !ps || *ps || attrs || (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS))
+    if (!block || !ps || *ps || attrs
+	|| (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS)
+#ifdef PERL_MAD
+	|| block->op_type == OP_NULL
+#endif
+	)
 	const_sv = NULL;
     else
 	const_sv = op_const_sv(block, NULL);
@@ -4554,10 +5085,14 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
          * skipping the prototype check
          */
         if (exists || SvPOK(cv))
-	    cv_ckproto(cv, gv, ps);
+	    cv_ckproto_len(cv, gv, ps, ps_len);
 	/* already defined (or promised)? */
 	if (exists || GvASSUMECV(gv)) {
-	    if (!block && !attrs) {
+	    if ((!block
+#ifdef PERL_MAD
+		 || block->op_type == OP_NULL
+#endif
+		 )&& !attrs) {
 		if (CvFLAGS(PL_compcv)) {
 		    /* might have had built-in attrs applied */
 		    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
@@ -4566,7 +5101,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		SAVEFREESV(PL_compcv);
 		goto done;
 	    }
-	    if (block) {
+	    if (block
+#ifdef PERL_MAD
+		&& block->op_type != OP_NULL
+#endif
+		) {
 		if (ckWARN(WARN_REDEFINE)
 		    || (CvCONST(cv)
 			&& (!const_sv || sv_cmp(cv_const_sv(cv), const_sv))))
@@ -4579,13 +5118,19 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 				    : "Subroutine %s redefined", name);
 		    CopLINE_set(PL_curcop, oldline);
 		}
-		SvREFCNT_dec(cv);
+#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) {
-	SvREFCNT_inc_void_NN(const_sv);
+	SvREFCNT_inc_simple_void_NN(const_sv);
 	if (cv) {
 	    assert(!CvROOT(cv) && !CvCONST(cv));
 	    sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
@@ -4598,10 +5143,12 @@ 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++;
+	if (PL_madskills)
+	    goto install_block;
 	op_free(block);
 	SvREFCNT_dec(PL_compcv);
 	PL_compcv = NULL;
-	PL_sub_generation++;
 	goto done;
     }
     if (attrs) {
@@ -4611,7 +5158,11 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>
 	 * before we clobber PL_compcv.
 	 */
-	if (cv && !block) {
+	if (cv && (!block
+#ifdef PERL_MAD
+		    || block->op_type == OP_NULL
+#endif
+		    )) {
 	    rcv = (SV*)cv;
 	    /* Might have had built-in attributes applied -- propagate them. */
 	    CvFLAGS(cv) |= (CvFLAGS(PL_compcv) & CVf_BUILTIN_ATTRS);
@@ -4633,7 +5184,15 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	apply_attrs(stash, rcv, attrs, FALSE);
     }
     if (cv) {				/* must reuse cv if autoloaded */
-	if (!block) {
+	if (
+#ifdef PERL_MAD
+	    (
+#endif
+	     !block
+#ifdef PERL_MAD
+	     || block->op_type == OP_NULL) && !PL_madskills
+#endif
+	     ) {
 	    /* got here with just attrs -- work done, so bug out */
 	    SAVEFREESV(PL_compcv);
 	    goto done;
@@ -4660,6 +5219,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	cv = PL_compcv;
 	if (name) {
 	    GvCV(gv) = cv;
+	    if (PL_madskills) {
+		if (strEQ(name, "import")) {
+		    PL_formfeed = (SV*)cv;
+		    Perl_warner(aTHX_ packWARN(WARN_VOID), "%lx\n", (long)cv);
+		}
+	    }
 	    GvCVGEN(gv) = 0;
 	    PL_sub_generation++;
 	}
@@ -4685,11 +5250,12 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 		else {
 		    /* force display of errors found but not reported */
 		    sv_catpv(ERRSV, not_safe);
-		    Perl_croak(aTHX_ "%"SVf, ERRSV);
+		    Perl_croak(aTHX_ "%"SVf, (void*)ERRSV);
 		}
 	    }
 	}
     }
+ install_block:
     if (!block)
 	goto done;
 
@@ -4700,8 +5266,13 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
     else {
 	/* This makes sub {}; work as expected.  */
 	if (block->op_type == OP_STUB) {
+	    OP* const newblock = newSTATEOP(0, NULL, 0);
+#ifdef PERL_MAD
+	    op_getmad(block,newblock,'B');
+#else
 	    op_free(block);
-	    block = newSTATEOP(0, NULL, 0);
+#endif
+	    block = newblock;
 	}
 	CvROOT(cv) = newUNOP(OP_LEAVESUB, 0, scalarseq(block));
     }
@@ -4772,7 +5343,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
 	    call_list(oldscope, PL_beginav);
 
 	    PL_curcop = &PL_compiling;
-	    PL_compiling.op_private = (U8)(PL_hints & HINT_PRIVATE_MASK);
+	    CopHINTS_set(&PL_compiling, PL_hints);
 	    LEAVE;
 	}
 	else if (strEQ(s, "END") && !PL_error_count) {
@@ -4825,6 +5396,15 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 {
     dVAR;
     CV* cv;
+#ifdef USE_ITHREADS
+    const char *const temp_p = CopFILE(PL_curcop);
+    const STRLEN len = temp_p ? strlen(temp_p) : 0;
+#else
+    SV *const temp_sv = CopFILESV(PL_curcop);
+    STRLEN len;
+    const char *const temp_p = temp_sv ? SvPV_const(temp_sv, len) : NULL;
+#endif
+    char *const file = savepvn(temp_p, temp_p ? len : 0);
 
     ENTER;
 
@@ -4841,10 +5421,13 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
 	CopSTASH_set(PL_curcop,stash);
     }
 
-    cv = newXS(name, const_sv_xsub, savepv(CopFILE(PL_curcop)));
+    /* file becomes the CvFILE. For an XS, it's supposed to be 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_flags(name, const_sv_xsub, file, "", XS_DYNAMIC_FILENAME);
     CvXSUBANY(cv).any_ptr = sv;
     CvCONST_on(cv);
-    sv_setpvn((SV*)cv, "", 0);  /* prototype is "" */
 
 #ifdef USE_ITHREADS
     if (stash)
@@ -4855,10 +5438,56 @@ Perl_newCONSTSUB(pTHX_ HV *stash, const char *name, SV *sv)
     return cv;
 }
 
+CV *
+Perl_newXS_flags(pTHX_ const char *name, XSUBADDR_t subaddr,
+		 const char *const filename, const char *const proto,
+		 U32 flags)
+{
+    CV *cv = newXS(name, subaddr, filename);
+
+    if (flags & XS_DYNAMIC_FILENAME) {
+	/* We need to "make arrangements" (ie cheat) to ensure that the
+	   filename lasts as long as the PVCV we just created, but also doesn't
+	   leak  */
+	STRLEN filename_len = strlen(filename);
+	STRLEN proto_and_file_len = filename_len;
+	char *proto_and_file;
+	STRLEN proto_len;
+
+	if (proto) {
+	    proto_len = strlen(proto);
+	    proto_and_file_len += proto_len;
+
+	    Newx(proto_and_file, proto_and_file_len + 1, char);
+	    Copy(proto, proto_and_file, proto_len, char);
+	    Copy(filename, proto_and_file + proto_len, filename_len + 1, char);
+	} else {
+	    proto_len = 0;
+	    proto_and_file = savepvn(filename, filename_len);
+	}
+
+	/* This gets free()d.  :-)  */
+	sv_usepvn_flags((SV*)cv, proto_and_file, proto_and_file_len,
+			SV_HAS_TRAILING_NUL);
+	if (proto) {
+	    /* This gives us the correct prototype, rather than one with the
+	       file name appended.  */
+	    SvCUR_set(cv, proto_len);
+	} else {
+	    SvPOK_off(cv);
+	}
+	CvFILE(cv) = proto_and_file + proto_len;
+    } else {
+	sv_setpv((SV *)cv, proto);
+    }
+    return cv;
+}
+
 /*
 =for apidoc U||newXS
 
-Used by C<xsubpp> to hook up XSUBs as Perl subs.
+Used by C<xsubpp> to hook up XSUBs as Perl subs.  I<filename> needs to be
+static storage, as it is used directly as CvFILE(), without a copy being made.
 
 =cut
 */
@@ -4974,11 +5603,18 @@ done:
     return cv;
 }
 
+#ifdef PERL_MAD
+OP *
+#else
 void
+#endif
 Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 {
     dVAR;
     register CV *cv;
+#ifdef PERL_MAD
+    OP* pegop = newOP(OP_NULL, 0);
+#endif
 
     GV * const gv = o
 	? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM)
@@ -4997,7 +5633,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
 		CopLINE_set(PL_curcop, PL_copline);
 	    Perl_warner(aTHX_ packWARN(WARN_REDEFINE),
 			o ? "Format %"SVf" redefined"
-			: "Format STDOUT redefined" ,cSVOPo->op_sv);
+			: "Format STDOUT redefined", (void*)cSVOPo->op_sv);
 	    CopLINE_set(PL_curcop, oldline);
 	}
 	SvREFCNT_dec(cv);
@@ -5015,9 +5651,17 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block)
     CvSTART(cv) = LINKLIST(CvROOT(cv));
     CvROOT(cv)->op_next = 0;
     CALL_PEEP(CvSTART(cv));
+#ifdef PERL_MAD
+    op_getmad(o,pegop,'n');
+    op_getmad_weak(block, pegop, 'b');
+#else
     op_free(o);
+#endif
     PL_copline = NOLINE;
     LEAVE_SCOPE(floor);
+#ifdef PERL_MAD
+    return pegop;
+#endif
 }
 
 OP *
@@ -5169,7 +5813,8 @@ OP *
 Perl_ck_anoncode(pTHX_ OP *o)
 {
     cSVOPo->op_targ = pad_add_anon(cSVOPo->op_sv, o->op_type);
-    cSVOPo->op_sv = NULL;
+    if (!PL_madskills)
+	cSVOPo->op_sv = NULL;
     return o;
 }
 
@@ -5229,15 +5874,18 @@ Perl_ck_spair(pTHX_ OP *o)
 	o = modkids(ck_fun(o), type);
 	kid = cUNOPo->op_first;
 	newop = kUNOP->op_first->op_sibling;
-	if (newop &&
-	    (newop->op_sibling ||
-	     !(PL_opargs[newop->op_type] & OA_RETSCALAR) ||
-	     newop->op_type == OP_PADAV || newop->op_type == OP_PADHV ||
-	     newop->op_type == OP_RV2AV || newop->op_type == OP_RV2HV)) {
-
-	    return o;
-	}
+	if (newop) {
+	    const OPCODE type = newop->op_type;
+	    if (newop->op_sibling || !(PL_opargs[type] & OA_RETSCALAR) ||
+		    type == OP_PADAV || type == OP_PADHV ||
+		    type == OP_RV2AV || type == OP_RV2HV)
+		return o;
+	}
+#ifdef PERL_MAD
+	op_getmad(kUNOP->op_first,newop,'K');
+#else
 	op_free(kUNOP->op_first);
+#endif
 	kUNOP->op_first = newop;
     }
     o->op_ppaddr = PL_ppaddr[++o->op_type];
@@ -5285,12 +5933,17 @@ OP *
 Perl_ck_eof(pTHX_ OP *o)
 {
     dVAR;
-    const I32 type = o->op_type;
 
     if (o->op_flags & OPf_KIDS) {
 	if (cLISTOPo->op_first->op_type == OP_STUB) {
+	    OP * const newop
+		= newUNOP(o->op_type, OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
+#ifdef PERL_MAD
+	    op_getmad(o,newop,'O');
+#else
 	    op_free(o);
-	    o = newUNOP(type, OPf_SPECIAL, newGVOP(OP_GV, 0, PL_argvgv));
+#endif
+	    o = newop;
 	}
 	return ck_fun(o);
     }
@@ -5311,9 +5964,14 @@ Perl_ck_eval(pTHX_ OP *o)
 	}
 	else if (kid->op_type == OP_LINESEQ || kid->op_type == OP_STUB) {
 	    LOGOP *enter;
+#ifdef PERL_MAD
+	    OP* const oldo = o;
+#endif
 
 	    cUNOPo->op_first = 0;
+#ifndef PERL_MAD
 	    op_free(o);
+#endif
 
 	    NewOp(1101, enter, 1, LOGOP);
 	    enter->op_type = OP_ENTERTRY;
@@ -5327,6 +5985,7 @@ Perl_ck_eval(pTHX_ OP *o)
 	    o->op_type = OP_LEAVETRY;
 	    o->op_ppaddr = PL_ppaddr[OP_LEAVETRY];
 	    enter->op_other = o;
+	    op_getmad(oldo,o,'O');
 	    return o;
 	}
 	else {
@@ -5335,13 +5994,19 @@ Perl_ck_eval(pTHX_ OP *o)
 	}
     }
     else {
+#ifdef PERL_MAD
+	OP* const oldo = o;
+#else
 	op_free(o);
+#endif
 	o = newUNOP(OP_ENTEREVAL, 0, newDEFSVOP());
+	op_getmad(oldo,o,'O');
     }
     o->op_targ = (PADOFFSET)PL_hints;
     if ((PL_hints & HINT_LOCALIZE_HH) != 0 && GvHV(PL_hintgv)) {
 	/* Store a copy of %^H that pp_entereval can pick up */
-	OP *hhop = newSVOP(OP_CONST, 0, (SV*)newHVhv(GvHV(PL_hintgv)));
+	OP *hhop = newSVOP(OP_CONST, 0,
+			   (SV*)Perl_hv_copy_hints_hv(aTHX_ GvHV(PL_hintgv)));
 	cUNOPo->op_first->op_sibling = hhop;
 	o->op_private |= OPpEVAL_HAS_HH;
     }
@@ -5474,8 +6139,8 @@ Perl_ck_rvconst(pTHX_ register OP *o)
 	    }
 	    if (badthing)
 		Perl_croak(aTHX_
-	  "Can't use bareword (\"%"SVf"\") as %s ref while \"strict refs\" in use",
-		      kidsv, badthing);
+			   "Can't use bareword (\"%"SVf"\") as %s ref while \"strict refs\" in use",
+			   (void*)kidsv, badthing);
 	}
 	/*
 	 * This is a little tricky.  We only want to add the symbol if we
@@ -5525,33 +6190,39 @@ Perl_ck_ftst(pTHX_ OP *o)
     const I32 type = o->op_type;
 
     if (o->op_flags & OPf_REF) {
-	/*EMPTY*/;
+	NOOP;
     }
     else if (o->op_flags & OPf_KIDS && cUNOPo->op_first->op_type != OP_STUB) {
 	SVOP * const kid = (SVOP*)cUNOPo->op_first;
+	const OPCODE kidtype = kid->op_type;
 
-	if (kid->op_type == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
+	if (kidtype == OP_CONST && (kid->op_private & OPpCONST_BARE)) {
 	    OP * const newop = newGVOP(type, OPf_REF,
 		gv_fetchsv(kid->op_sv, GV_ADD, SVt_PVIO));
+#ifdef PERL_MAD
+	    op_getmad(o,newop,'O');
+#else
 	    op_free(o);
-	    o = newop;
-	    return o;
+#endif
+	    return newop;
 	}
-	else {
-	  if ((PL_hints & HINT_FILETEST_ACCESS) &&
-	      OP_IS_FILETEST_ACCESS(o))
+	if ((PL_hints & HINT_FILETEST_ACCESS) && OP_IS_FILETEST_ACCESS(o))
 	    o->op_private |= OPpFT_ACCESS;
-	}
-	if (PL_check[kid->op_type] == MEMBER_TO_FPTR(Perl_ck_ftst)
-		&& kid->op_type != OP_STAT && kid->op_type != OP_LSTAT)
+	if (PL_check[kidtype] == MEMBER_TO_FPTR(Perl_ck_ftst)
+		&& kidtype != OP_STAT && kidtype != OP_LSTAT)
 	    o->op_private |= OPpFT_STACKED;
     }
     else {
+#ifdef PERL_MAD
+	OP* const oldo = o;
+#else
 	op_free(o);
+#endif
 	if (type == OP_FTTTY)
 	    o = newGVOP(type, OPf_REF, PL_stdingv);
 	else
 	    o = newUNOP(type, 0, newDEFSVOP());
+	op_getmad(oldo,o,'O');
     }
     return o;
 }
@@ -5588,6 +6259,12 @@ Perl_ck_fun(pTHX_ OP *o)
 	while (oa && kid) {
 	    numargs++;
 	    sibl = kid->op_sibling;
+#ifdef PERL_MAD
+	    if (!sibl && kid->op_type == OP_STUB) {
+		numargs--;
+		break;
+	    }
+#endif
 	    switch (oa & 7) {
 	    case OA_SCALAR:
 		/* list seen where single (scalar) arg expected? */
@@ -5621,8 +6298,12 @@ Perl_ck_fun(pTHX_ OP *o)
 		    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
 			Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			    "Array @%"SVf" missing the @ in argument %"IVdf" of %s()",
-			    ((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
+			    (void*)((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
+#ifdef PERL_MAD
+		    op_getmad(kid,newop,'K');
+#else
 		    op_free(kid);
+#endif
 		    kid = newop;
 		    kid->op_sibling = sibl;
 		    *tokid = kid;
@@ -5640,8 +6321,12 @@ Perl_ck_fun(pTHX_ OP *o)
 		    if (ckWARN2(WARN_DEPRECATED, WARN_SYNTAX))
 			Perl_warner(aTHX_ packWARN2(WARN_DEPRECATED, WARN_SYNTAX),
 			    "Hash %%%"SVf" missing the %% in argument %"IVdf" of %s()",
-			    ((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
+			    (void*)((SVOP*)kid)->op_sv, (IV)numargs, PL_op_desc[type]);
+#ifdef PERL_MAD
+		    op_getmad(kid,newop,'K');
+#else
 		    op_free(kid);
+#endif
 		    kid = newop;
 		    kid->op_sibling = sibl;
 		    *tokid = kid;
@@ -5671,7 +6356,11 @@ Perl_ck_fun(pTHX_ OP *o)
 			if (!(o->op_private & 1) && /* if not unop */
 			    kid == cLISTOPo->op_last)
 			    cLISTOPo->op_last = newop;
+#ifdef PERL_MAD
+			op_getmad(kid,newop,'K');
+#else
 			op_free(kid);
+#endif
 			kid = newop;
 		    }
 		    else if (kid->op_type == OP_READLINE) {
@@ -5713,6 +6402,7 @@ Perl_ck_fun(pTHX_ OP *o)
 			    else if (kid->op_type == OP_AELEM
 				     || kid->op_type == OP_HELEM)
 			    {
+				 OP *firstop;
 				 OP *op = ((BINOP*)kid)->op_first;
 				 name = NULL;
 				 if (op) {
@@ -5722,10 +6412,10 @@ Perl_ck_fun(pTHX_ OP *o)
 					   "[]" : "{}";
 				      if (((op->op_type == OP_RV2AV) ||
 					   (op->op_type == OP_RV2HV)) &&
-					  (op = ((UNOP*)op)->op_first) &&
-					  (op->op_type == OP_GV)) {
+					  (firstop = ((UNOP*)op)->op_first) &&
+					  (firstop->op_type == OP_GV)) {
 					   /* packagevar $a[] or $h{} */
-					   GV * const gv = cGVOPx_gv(op);
+					   GV * const gv = cGVOPx_gv(firstop);
 					   if (gv)
 						tmpstr =
 						     Perl_newSVpvf(aTHX_
@@ -5784,14 +6474,28 @@ Perl_ck_fun(pTHX_ OP *o)
 	    tokid = &kid->op_sibling;
 	    kid = kid->op_sibling;
 	}
+#ifdef PERL_MAD
+	if (kid && kid->op_type != OP_STUB)
+	    return too_many_arguments(o,OP_DESC(o));
+	o->op_private |= numargs;
+#else
+	/* FIXME - should the numargs move as for the PERL_MAD case?  */
 	o->op_private |= numargs;
 	if (kid)
 	    return too_many_arguments(o,OP_DESC(o));
+#endif
 	listkids(o);
     }
     else if (PL_opargs[type] & OA_DEFGV) {
+#ifdef PERL_MAD
+	OP *newop = newUNOP(type, 0, newDEFSVOP());
+	op_getmad(o,newop,'O');
+	return newop;
+#else
+	/* Ordering of these two is important to keep f_map.t passing.  */
 	op_free(o);
 	return newUNOP(type, 0, newDEFSVOP());
+#endif
     }
 
     if (oa) {
@@ -5862,13 +6566,13 @@ OP *
 Perl_ck_grep(pTHX_ OP *o)
 {
     dVAR;
-    LOGOP *gwop;
+    LOGOP *gwop = NULL;
     OP *kid;
     const OPCODE type = o->op_type == OP_GREPSTART ? OP_GREPWHILE : OP_MAPWHILE;
-    I32 offset;
+    PADOFFSET offset;
 
     o->op_ppaddr = PL_ppaddr[OP_GREPSTART];
-    NewOp(1101, gwop, 1, LOGOP);
+    /* don't allocate gwop here, as we may leak it if PL_error_count > 0 */
 
     if (o->op_flags & OPf_STACKED) {
 	OP* k;
@@ -5879,6 +6583,7 @@ Perl_ck_grep(pTHX_ OP *o)
 	for (k = cUNOPx(kid)->op_first; k; k = k->op_next) {
 	    kid = k;
 	}
+	NewOp(1101, gwop, 1, LOGOP);
 	kid->op_next = (OP*)gwop;
 	o->op_flags &= ~OPf_STACKED;
     }
@@ -5895,6 +6600,8 @@ Perl_ck_grep(pTHX_ OP *o)
 	Perl_croak(aTHX_ "panic: ck_grep");
     kid = kUNOP->op_first;
 
+    if (!gwop)
+	NewOp(1101, gwop, 1, LOGOP);
     gwop->op_type = type;
     gwop->op_ppaddr = PL_ppaddr[type];
     gwop->op_first = listkids(o);
@@ -6063,7 +6770,7 @@ Perl_ck_smartmatch(pTHX_ OP *o)
 OP *
 Perl_ck_sassign(pTHX_ OP *o)
 {
-    OP *kid = cLISTOPo->op_first;
+    OP * const kid = cLISTOPo->op_first;
     /* has a disposable target? */
     if ((PL_opargs[kid->op_type] & OA_TARGLEX)
 	&& !(kid->op_flags & OPf_STACKED)
@@ -6081,12 +6788,27 @@ 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;
 	}
     }
+    if (kid->op_sibling) {
+	OP *kkid = kid->op_sibling;
+	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;
+	    /* hijacking PADSTALE for uninitialized state variables */
+	    SvPADSTALE_on(PAD_SVl(kkid->op_targ));
+	}
+    }
     return o;
 }
 
@@ -6095,7 +6817,7 @@ Perl_ck_match(pTHX_ OP *o)
 {
     dVAR;
     if (o->op_type != OP_QR && PL_compcv) {
-	const I32 offset = pad_findmy("$_");
+	const PADOFFSET offset = pad_findmy("$_");
 	if (offset != NOT_IN_PAD && !(PAD_COMPNAME_FLAGS_isOUR(offset))) {
 	    o->op_targ = offset;
 	    o->op_private |= OPpTARGET_MY;
@@ -6122,7 +6844,11 @@ Perl_ck_method(pTHX_ OP *o)
 		kSVOP->op_sv = NULL;
 	    }
 	    cmop = newSVOP(OP_METHOD_NAMED, 0, sv);
+#ifdef PERL_MAD
+	    op_getmad(o,cmop,'O');
+#else
 	    op_free(o);
+#endif
 	    return cmop;
 	}
     }
@@ -6245,13 +6971,19 @@ Perl_ck_require(pTHX_ OP *o)
 
     if (gv && GvCVu(gv) && GvIMPORTED_CV(gv)) {
 	OP * const kid = cUNOPo->op_first;
+	OP * newop;
+
 	cUNOPo->op_first = 0;
+#ifndef PERL_MAD
 	op_free(o);
-	return ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
-			       append_elem(OP_LIST, kid,
-					   scalar(newUNOP(OP_RV2CV, 0,
-							  newGVOP(OP_GV, 0,
-								  gv))))));
+#endif
+	newop = ck_subr(newUNOP(OP_ENTERSUB, OPf_STACKED,
+				append_elem(OP_LIST, kid,
+					    scalar(newUNOP(OP_RV2CV, 0,
+							   newGVOP(OP_GV, 0,
+								   gv))))));
+	op_getmad(o,newop,'O');
+	return newop;
     }
 
     return ck_fun(o);
@@ -6298,11 +7030,21 @@ Perl_ck_shift(pTHX_ OP *o)
 
     if (!(o->op_flags & OPf_KIDS)) {
 	OP *argop;
-
+	/* FIXME - this can be refactored to reduce code in #ifdefs  */
+#ifdef PERL_MAD
+	OP * const oldo = o;
+#else
 	op_free(o);
+#endif
 	argop = newUNOP(OP_RV2AV, 0,
 	    scalar(newGVOP(OP_GV, 0, CvUNIQUE(PL_compcv) ? PL_argvgv : PL_defgv)));
+#ifdef PERL_MAD
+	o = newUNOP(type, 0, scalar(argop));
+	op_getmad(oldo,o,'O');
+	return o;
+#else
 	return newUNOP(type, 0, scalar(argop));
+#endif
     }
     return scalar(modkids(ck_fun(o), type));
 }
@@ -6313,8 +7055,7 @@ Perl_ck_sort(pTHX_ OP *o)
     dVAR;
     OP *firstkid;
 
-    if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0)
-    {
+    if (o->op_type == OP_SORT && (PL_hints & HINT_LOCALIZE_HH) != 0) {
 	HV * const hinthv = GvHV(PL_hintgv);
 	if (hinthv) {
 	    SV ** const svp = hv_fetchs(hinthv, "sort", FALSE);
@@ -6453,7 +7194,11 @@ S_simplify_sort(pTHX_ OP *o)
 	o->op_private |= OPpSORT_NUMERIC | OPpSORT_INTEGER;
     kid = cLISTOPo->op_first->op_sibling;
     cLISTOPo->op_first->op_sibling = kid->op_sibling; /* bypass old block */
+#ifdef PERL_MAD
+    op_getmad(kid,o,'S');			      /* then delete it */
+#else
     op_free(kid);				      /* then delete it */
+#endif
 }
 
 OP *
@@ -6502,6 +7247,7 @@ Perl_ck_split(pTHX_ OP *o)
 
     if (!kid->op_sibling)
 	append_elem(OP_SPLIT, o, newSVOP(OP_CONST, 0, newSViv(0)));
+    assert(kid->op_sibling);
 
     kid = kid->op_sibling;
     scalar(kid);
@@ -6536,7 +7282,8 @@ Perl_ck_subr(pTHX_ OP *o)
 	     ? cUNOPo : ((UNOP*)cUNOPo->op_first))->op_first;
     OP *o2 = prev->op_sibling;
     OP *cvop;
-    char *proto = NULL;
+    const char *proto = NULL;
+    const char *proto_end = NULL;
     CV *cv = NULL;
     GV *namegv = NULL;
     int optional = 0;
@@ -6559,8 +7306,10 @@ Perl_ck_subr(pTHX_ OP *o)
 		tmpop->op_private |= OPpEARLY_CV;
 	    else {
 		if (SvPOK(cv)) {
+		    STRLEN len;
 		    namegv = CvANON(cv) ? gv : CvGV(cv);
-		    proto = SvPV_nolen((SV*)cv);
+		    proto = SvPV((SV*)cv, len);
+		    proto_end = proto + len;
 		}
 		if (CvASSERTION(cv)) {
 		    if (PL_hints & HINT_ASSERTING) {
@@ -6591,10 +7340,16 @@ Perl_ck_subr(pTHX_ OP *o)
     if (PERLDB_SUB && PL_curstash != PL_debstash)
 	o->op_private |= OPpENTERSUB_DB;
     while (o2 != cvop) {
+	OP* o3;
+	if (PL_madskills && o2->op_type == OP_NULL)
+	    o3 = ((UNOP*)o2)->op_first;
+	else
+	    o3 = o2;
 	if (proto) {
-	    switch (*proto) {
-	    case '\0':
+	    if (proto >= proto_end)
 		return too_many_arguments(o, gv_ename(namegv));
+
+	    switch (*proto) {
 	    case ';':
 		optional = 1;
 		proto++;
@@ -6612,22 +7367,22 @@ Perl_ck_subr(pTHX_ OP *o)
 	    case '&':
 		proto++;
 		arg++;
-		if (o2->op_type != OP_REFGEN && o2->op_type != OP_UNDEF)
+		if (o3->op_type != OP_REFGEN && o3->op_type != OP_UNDEF)
 		    bad_type(arg,
 			arg == 1 ? "block or sub {}" : "sub {}",
-			gv_ename(namegv), o2);
+			gv_ename(namegv), o3);
 		break;
 	    case '*':
 		/* '*' allows any scalar type, including bareword */
 		proto++;
 		arg++;
-		if (o2->op_type == OP_RV2GV)
+		if (o3->op_type == OP_RV2GV)
 		    goto wrapref;	/* autoconvert GLOB -> GLOBref */
-		else if (o2->op_type == OP_CONST)
-		    o2->op_private &= ~OPpCONST_STRICT;
-		else if (o2->op_type == OP_ENTERSUB) {
+		else if (o3->op_type == OP_CONST)
+		    o3->op_private &= ~OPpCONST_STRICT;
+		else if (o3->op_type == OP_ENTERSUB) {
 		    /* accidental subroutine, revert to bareword */
-		    OP *gvop = ((UNOP*)o2)->op_first;
+		    OP *gvop = ((UNOP*)o3)->op_first;
 		    if (gvop && gvop->op_type == OP_NULL) {
 			gvop = ((UNOP*)gvop)->op_first;
 			if (gvop) {
@@ -6641,9 +7396,14 @@ Perl_ck_subr(pTHX_ OP *o)
 				GV * const gv = cGVOPx_gv(gvop);
 				OP * const sibling = o2->op_sibling;
 				SV * const n = newSVpvs("");
+#ifdef PERL_MAD
+				OP * const oldo2 = o2;
+#else
 				op_free(o2);
+#endif
 				gv_fullname4(n, gv, "", FALSE);
 				o2 = newSVOP(OP_CONST, 0, n);
+				op_getmad(oldo2,o2,'O');
 				prev->op_sibling = o2;
 				o2->op_sibling = sibling;
 			    }
@@ -6672,53 +7432,52 @@ Perl_ck_subr(pTHX_ OP *o)
 		     break;
 		case ']':
 		     if (contextclass) {
-			 /* XXX We shouldn't be modifying proto, so we can const proto */
-		         char *p = proto;
-			 const char s = *p;
+		         const char *p = proto;
+			 const char *const end = proto;
 			 contextclass = 0;
-			 *p = '\0';
 			 while (*--p != '[');
-			 bad_type(arg, Perl_form(aTHX_ "one of %s", p),
-				 gv_ename(namegv), o2);
-			 *proto = s;
+			 bad_type(arg, Perl_form(aTHX_ "one of %.*s",
+						 (int)(end - p), p),
+				  gv_ename(namegv), o3);
 		     } else
 			  goto oops;
 		     break;
 		case '*':
-		     if (o2->op_type == OP_RV2GV)
+		     if (o3->op_type == OP_RV2GV)
 			  goto wrapref;
 		     if (!contextclass)
-			  bad_type(arg, "symbol", gv_ename(namegv), o2);
+			  bad_type(arg, "symbol", gv_ename(namegv), o3);
 		     break;
 		case '&':
-		     if (o2->op_type == OP_ENTERSUB)
+		     if (o3->op_type == OP_ENTERSUB)
 			  goto wrapref;
 		     if (!contextclass)
-			  bad_type(arg, "subroutine entry", gv_ename(namegv), o2);
+			  bad_type(arg, "subroutine entry", gv_ename(namegv),
+				   o3);
 		     break;
 		case '$':
-		    if (o2->op_type == OP_RV2SV ||
-			o2->op_type == OP_PADSV ||
-			o2->op_type == OP_HELEM ||
-			o2->op_type == OP_AELEM ||
-			o2->op_type == OP_THREADSV)
+		    if (o3->op_type == OP_RV2SV ||
+			o3->op_type == OP_PADSV ||
+			o3->op_type == OP_HELEM ||
+			o3->op_type == OP_AELEM ||
+			o3->op_type == OP_THREADSV)
 			 goto wrapref;
 		    if (!contextclass)
-			bad_type(arg, "scalar", gv_ename(namegv), o2);
+			bad_type(arg, "scalar", gv_ename(namegv), o3);
 		     break;
 		case '@':
-		    if (o2->op_type == OP_RV2AV ||
-			o2->op_type == OP_PADAV)
+		    if (o3->op_type == OP_RV2AV ||
+			o3->op_type == OP_PADAV)
 			 goto wrapref;
 		    if (!contextclass)
-			bad_type(arg, "array", gv_ename(namegv), o2);
+			bad_type(arg, "array", gv_ename(namegv), o3);
 		    break;
 		case '%':
-		    if (o2->op_type == OP_RV2HV ||
-			o2->op_type == OP_PADHV)
+		    if (o3->op_type == OP_RV2HV ||
+			o3->op_type == OP_PADHV)
 			 goto wrapref;
 		    if (!contextclass)
-			 bad_type(arg, "hash", gv_ename(namegv), o2);
+			 bad_type(arg, "hash", gv_ename(namegv), o3);
 		    break;
 		wrapref:
 		    {
@@ -6745,7 +7504,7 @@ Perl_ck_subr(pTHX_ OP *o)
 	    default:
 	      oops:
 		Perl_croak(aTHX_ "Malformed prototype for %s: %"SVf,
-			   gv_ename(namegv), cv);
+			   gv_ename(namegv), (void*)cv);
 	    }
 	}
 	else
@@ -6754,12 +7513,17 @@ Perl_ck_subr(pTHX_ OP *o)
 	prev = o2;
 	o2 = o2->op_sibling;
     } /* while */
-    if (proto && !optional &&
-	  (*proto && *proto != '@' && *proto != '%' && *proto != ';'))
+    if (proto && !optional && proto_end > proto &&
+	(*proto != '@' && *proto != '%' && *proto != ';'))
 	return too_few_arguments(o, gv_ename(namegv));
     if(delete_op) {
+#ifdef PERL_MAD
+	OP * const oldo = o;
+#else
 	op_free(o);
+#endif
 	o=newSVOP(OP_CONST, 0, newSViv(0));
+	op_getmad(oldo,o,'O');
     }
     return o;
 }
@@ -6776,7 +7540,7 @@ OP *
 Perl_ck_chdir(pTHX_ OP *o)
 {
     if (o->op_flags & OPf_KIDS) {
-	SVOP *kid = (SVOP*)cUNOPo->op_first;
+	SVOP * const kid = (SVOP*)cUNOPo->op_first;
 
 	if (kid && kid->op_type == OP_CONST &&
 	    (kid->op_private & OPpCONST_BARE))
@@ -6822,7 +7586,7 @@ OP *
 Perl_ck_substr(pTHX_ OP *o)
 {
     o = ck_fun(o);
-    if ((o->op_flags & OPf_KIDS) && o->op_private == 4) {
+    if ((o->op_flags & OPf_KIDS) && (o->op_private == 4)) {
 	OP *kid = cLISTOPo->op_first;
 
 	if (kid->op_type == OP_NULL)
@@ -6966,7 +7730,7 @@ Perl_peep(pTHX_ register OP *o)
 		    pop->op_next->op_type == OP_AELEM &&
 		    !(pop->op_next->op_private &
 		      (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF|OPpMAYBE_LVSUB)) &&
-		    (i = SvIV(((SVOP*)pop)->op_sv) - PL_curcop->cop_arybase)
+		    (i = SvIV(((SVOP*)pop)->op_sv) - CopARYBASE_get(PL_curcop))
 				<= 255 &&
 		    i >= 0)
 		{
@@ -7011,7 +7775,7 @@ Perl_peep(pTHX_ register OP *o)
 		    gv_efullname3(sv, gv, NULL);
 		    Perl_warner(aTHX_ packWARN(WARN_PROTOTYPE),
 				"%"SVf"() called too early to check prototype",
-				sv);
+				(void*)sv);
 		}
 	    }
 	    else if (o->op_next->op_type == OP_READLINE
@@ -7074,18 +7838,17 @@ Perl_peep(pTHX_ register OP *o)
 	    if (o->op_next && o->op_next->op_type == OP_NEXTSTATE
 		&& ckWARN(WARN_SYNTAX))
 	    {
-		if (o->op_next->op_sibling &&
-			o->op_next->op_sibling->op_type != OP_EXIT &&
-			o->op_next->op_sibling->op_type != OP_WARN &&
-			o->op_next->op_sibling->op_type != OP_DIE) {
-		    const line_t oldline = CopLINE(PL_curcop);
-
-		    CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
-		    Perl_warner(aTHX_ packWARN(WARN_EXEC),
-				"Statement unlikely to be reached");
-		    Perl_warner(aTHX_ packWARN(WARN_EXEC),
-				"\t(Maybe you meant system() when you said exec()?)\n");
-		    CopLINE_set(PL_curcop, oldline);
+		if (o->op_next->op_sibling) {
+		    const OPCODE type = o->op_next->op_sibling->op_type;
+		    if (type != OP_EXIT && type != OP_WARN && type != OP_DIE) {
+			const line_t oldline = CopLINE(PL_curcop);
+			CopLINE_set(PL_curcop, CopLINE((COP*)o->op_next));
+			Perl_warner(aTHX_ packWARN(WARN_EXEC),
+				    "Statement unlikely to be reached");
+			Perl_warner(aTHX_ packWARN(WARN_EXEC),
+				    "\t(Maybe you meant system() when you said exec()?)\n");
+			CopLINE_set(PL_curcop, oldline);
+		    }
 		}
 	    }
 	    break;
@@ -7108,7 +7871,7 @@ Perl_peep(pTHX_ register OP *o)
 	    if ((!SvFAKE(sv = *svp) || !SvREADONLY(sv)) && !IS_PADCONST(sv)) {
 		key = SvPV_const(sv, keylen);
 		lexname = newSVpvn_share(key,
-					 SvUTF8(sv) ? -(I32)keylen : keylen,
+					 SvUTF8(sv) ? -(I32)keylen : (I32)keylen,
 					 0);
 		SvREFCNT_dec(sv);
 		*svp = lexname;
@@ -7128,7 +7891,7 @@ Perl_peep(pTHX_ register OP *o)
 		break;
 	    key = SvPV_const(*svp, keylen);
 	    if (!hv_fetch(GvHV(*fields), key,
-			SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
+			SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE))
 	    {
 		Perl_croak(aTHX_ "No such class field \"%s\" " 
 			   "in variable %s of type %s", 
@@ -7185,7 +7948,7 @@ Perl_peep(pTHX_ register OP *o)
 		svp = cSVOPx_svp(key_op);
 		key = SvPV_const(*svp, keylen);
 		if (!hv_fetch(GvHV(*fields), key, 
-			    SvUTF8(*svp) ? -(I32)keylen : keylen, FALSE))
+			    SvUTF8(*svp) ? -(I32)keylen : (I32)keylen, FALSE))
 		{
 		    Perl_croak(aTHX_ "No such class field \"%s\" "
 			       "in variable %s of type %s",
@@ -7514,7 +8277,7 @@ const_sv_xsub(pTHX_ CV* cv)
     dVAR;
     dXSARGS;
     if (items != 0) {
-	/*EMPTY*/;
+	NOOP;
 #if 0
         Perl_croak(aTHX_ "usage: %s::%s()",
                    HvNAME_get(GvSTASH(CvGV(cv))), GvNAME(CvGV(cv)));