import perl 5.10.0 from CPAN

1 files changed, 545 insertions, 439 deletions

diff --git a/gnu/usr.bin/perl/pad.c b/gnu/usr.bin/perl/pad.c
index 21e1e6d2708..6e33495fcb7 100644
--- a/gnu/usr.bin/perl/pad.c
+++ b/gnu/usr.bin/perl/pad.c
@@ -1,6 +1,6 @@
 /*    pad.c
  *
- *    Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -32,7 +32,8 @@ CV's can have CvPADLIST(cv) set to point to an AV.
 
 For these purposes "forms" are a kind-of CV, eval""s are too (except they're
 not callable at will and are always thrown away after the eval"" is done
-executing).
+executing). Require'd files are simply evals without any outer lexical
+scope.
 
 XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
 but that is really the callers pad (a slot of which is allocated by
@@ -71,23 +72,30 @@ but only by their index allocated at compile time (which is usually
 in PL_op->op_targ), wasting a name SV for them doesn't make sense.
 
 The SVs in the names AV have their PV being the name of the variable.
-NV+1..IV inclusive is a range of cop_seq numbers for which the name is
-valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH points at the
-type.  For C<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
-stash of the associated global (so that duplicate C<our> declarations in the
-same package can be detected).  SvCUR is sometimes hijacked to
-store the generation number during compilation.
-
-If SvFAKE is set on the name SV then slot in the frame AVs are
-a REFCNT'ed references to a lexical from "outside". In this case,
-the name SV does not have a cop_seq range, since it is in scope
-throughout.
+xlow+1..xhigh inclusive in the NV union is a range of cop_seq numbers for
+which the name is valid.  For typed lexicals name SV is SVt_PVMG and SvSTASH
+points at the type.  For C<our> lexicals, the type is also SVt_PVMG, with the
+SvOURSTASH slot pointing at the stash of the associated global (so that
+duplicate C<our> declarations in the same package can be detected).  SvUVX is
+sometimes hijacked to store the generation number during compilation.
+
+If SvFAKE is set on the name SV, then that slot in the frame AV is
+a REFCNT'ed reference to a lexical from "outside". In this case,
+the name SV does not use xlow and xhigh to store a cop_seq range, since it is
+in scope throughout. Instead xhigh stores some flags containing info about
+the real lexical (is it declared in an anon, and is it capable of being
+instantiated multiple times?), and for fake ANONs, xlow contains the index
+within the parent's pad where the lexical's value is stored, to make
+cloning quicker.
 
 If the 'name' is '&' the corresponding entry in frame AV
 is a CV representing a possible closure.
 (SvFAKE and name of '&' is not a meaningful combination currently but could
 become so if C<my sub foo {}> is implemented.)
 
+Note that formats are treated as anon subs, and are cloned each time
+write is called (if necessary).
+
 The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
 and set on scope exit. This allows the 'Variable $x is not available' warning
 to be generated in evals, such as 
@@ -101,11 +109,26 @@ to be generated in evals, such as
 #include "EXTERN.h"
 #define PERL_IN_PAD_C
 #include "perl.h"
+#include "keywords.h"
 
+#define COP_SEQ_RANGE_LOW_set(sv,val)		\
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
+#define COP_SEQ_RANGE_HIGH_set(sv,val)		\
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
 
-#define PAD_MAX 999999999
+#define PARENT_PAD_INDEX_set(sv,val)		\
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END
+#define PARENT_FAKELEX_FLAGS_set(sv,val)	\
+  STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
 
+#define PAD_MAX I32_MAX
 
+#ifdef PERL_MAD
+void pad_peg(const char* s) {
+    static int pegcnt;
+    pegcnt++;
+}
+#endif
 
 /*
 =for apidoc pad_new
@@ -124,6 +147,7 @@ can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
+    dVAR;
     AV *padlist, *padname, *pad;
 
     ASSERT_CURPAD_LEGAL("pad_new");
@@ -144,6 +168,7 @@ Perl_pad_new(pTHX_ int flags)
 	    SAVEI32(PL_comppad_name_fill);
 	    SAVEI32(PL_min_intro_pending);
 	    SAVEI32(PL_max_intro_pending);
+	    SAVEBOOL(PL_cv_has_eval);
 	    if (flags & padnew_SAVESUB) {
 		SAVEI32(PL_pad_reset_pending);
 	    }
@@ -167,17 +192,10 @@ Perl_pad_new(pTHX_ int flags)
         AV * const a0 = newAV();			/* will be @_ */
 	av_extend(a0, 0);
 	av_store(pad, 0, (SV*)a0);
-	AvFLAGS(a0) = AVf_REIFY;
+	AvREIFY_only(a0);
     }
     else {
-#ifdef USE_5005THREADS
-        AV * const a0 = newAV();			/* will be @_ */
-	av_store(padname, 0, newSVpvn("@_", 2));
-	SvPADMY_on((SV*)a0);		/* XXX Needed? */
-	av_store(pad, 0, (SV*)a0);
-#else
-	av_store(pad, 0, Nullsv);
-#endif /* USE_THREADS */
+	av_store(pad, 0, NULL);
     }
 
     AvREAL_off(padlist);
@@ -194,12 +212,13 @@ Perl_pad_new(pTHX_ int flags)
 	PL_comppad_name_fill = 0;
 	PL_min_intro_pending = 0;
 	PL_padix	     = 0;
+	PL_cv_has_eval	     = 0;
     }
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-	  "Pad 0x%"UVxf"[0x%"UVxf"] new:       padlist=0x%"UVxf
+	  "Pad 0x%"UVxf"[0x%"UVxf"] new:       compcv=0x%"UVxf
 	      " name=0x%"UVxf" flags=0x%"UVxf"\n",
-	  PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(padlist),
+	  PTR2UV(PL_comppad), PTR2UV(PL_curpad), PTR2UV(PL_compcv),
 	      PTR2UV(padname), (UV)flags
 	)
     );
@@ -225,16 +244,19 @@ taken)
 void
 Perl_pad_undef(pTHX_ CV* cv)
 {
+    dVAR;
     I32 ix;
     const PADLIST * const padlist = CvPADLIST(cv);
 
+    pad_peg("pad_undef");
     if (!padlist)
 	return;
-    if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
+    if (SvIS_FREED(padlist)) /* may be during global destruction */
 	return;
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
-	  "Pad undef: padlist=0x%"UVxf"\n" , PTR2UV(padlist))
+	  "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n",
+	    PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
     );
 
     /* detach any '&' anon children in the pad; if afterwards they
@@ -258,50 +280,48 @@ Perl_pad_undef(pTHX_ CV* cv)
 		CV * const innercv = (CV*)curpad[ix];
 		U32 inner_rc = SvREFCNT(innercv);
 		assert(inner_rc);
-		namepad[ix] = Nullsv;
+		namepad[ix] = NULL;
 		SvREFCNT_dec(namesv);
 
 		if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
-		    curpad[ix] = Nullsv;
+		    curpad[ix] = NULL;
 		    SvREFCNT_dec(innercv);
 		    inner_rc--;
 		}
-		if (inner_rc /* in use, not just a prototype */
-		    && CvOUTSIDE(innercv) == cv)
-		{
+
+		/* in use, not just a prototype */
+		if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
 		    assert(CvWEAKOUTSIDE(innercv));
 		    /* don't relink to grandfather if he's being freed */
 		    if (outercv && SvREFCNT(outercv)) {
 			CvWEAKOUTSIDE_off(innercv);
 			CvOUTSIDE(innercv) = outercv;
 			CvOUTSIDE_SEQ(innercv) = seq;
-			(void)SvREFCNT_inc(outercv);
+			SvREFCNT_inc_simple_void_NN(outercv);
 		    }
 		    else {
-			CvOUTSIDE(innercv) = Nullcv;
+			CvOUTSIDE(innercv) = NULL;
 		    }
-
 		}
-
 	    }
 	}
     }
 
     ix = AvFILLp(padlist);
     while (ix >= 0) {
-	SV* const sv = AvARRAY(padlist)[ix--];
-	if (!sv)
-	    continue;
-	if (sv == (SV*)PL_comppad_name)
-	    PL_comppad_name = Nullav;
-	else if (sv == (SV*)PL_comppad) {
-	    PL_comppad = Null(PAD*);
-	    PL_curpad = Null(SV**);
+	const SV* const sv = AvARRAY(padlist)[ix--];
+	if (sv) {
+	    if (sv == (SV*)PL_comppad_name)
+		PL_comppad_name = NULL;
+	    else if (sv == (SV*)PL_comppad) {
+		PL_comppad = NULL;
+		PL_curpad = NULL;
+	    }
 	}
 	SvREFCNT_dec(sv);
     }
     SvREFCNT_dec((SV*)CvPADLIST(cv));
-    CvPADLIST(cv) = Null(PADLIST*);
+    CvPADLIST(cv) = NULL;
 }
 
 
@@ -310,64 +330,59 @@ Perl_pad_undef(pTHX_ CV* cv)
 /*
 =for apidoc pad_add_name
 
-Create a new name in the current pad at the specified offset.
+Create a new name and associated PADMY SV in the current pad; return the
+offset.
 If C<typestash> is valid, the name is for a typed lexical; set the
 name's stash to that value.
 If C<ourstash> is valid, it's an our lexical, set the name's
-GvSTASH to that value
-
-Also, if the name is @.. or %.., create a new array or hash for that slot
+SvOURSTASH to that value
 
 If fake, it means we're cloning an existing entry
 
 =cut
 */
 
-/*
- * XXX DAPM this doesn't seem the right place to create a new array/hash.
- * Whatever we do, we should be consistent - create scalars too, and
- * create even if fake. Really need to integrate better the whole entry
- * creation business - when + where does the name and value get created?
- */
-
 PADOFFSET
-Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
+Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state)
 {
+    dVAR;
     const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
-    SV* const namesv = NEWSV(1102, 0);
+    SV* const namesv
+	= newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
 
     ASSERT_CURPAD_ACTIVE("pad_add_name");
 
-
-    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-	  "Pad addname: %ld \"%s\"%s\n",
-	   (long)offset, name, (fake ? " FAKE" : "")
-	  )
-    );
-
-    sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV);
     sv_setpv(namesv, name);
 
     if (typestash) {
-	SvFLAGS(namesv) |= SVpad_TYPED;
-	SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
+	assert(SvTYPE(namesv) == SVt_PVMG);
+	SvPAD_TYPED_on(namesv);
+	SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash));
     }
     if (ourstash) {
-	SvFLAGS(namesv) |= SVpad_OUR;
-	GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
+	SvPAD_OUR_on(namesv);
+	SvOURSTASH_set(namesv, ourstash);
+	SvREFCNT_inc_simple_void_NN(ourstash);
+    }
+    else if (state) {
+	SvPAD_STATE_on(namesv);
     }
 
     av_store(PL_comppad_name, offset, namesv);
-    if (fake)
+    if (fake) {
 	SvFAKE_on(namesv);
+	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+	    "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
+    }
     else {
 	/* not yet introduced */
-	SvNV_set(namesv, (NV)PAD_MAX);	/* min */
-	SvIV_set(namesv, 0);		/* max */
+	COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX);	/* min */
+	COP_SEQ_RANGE_HIGH_set(namesv, 0);		/* max */
 
 	if (!PL_min_intro_pending)
 	    PL_min_intro_pending = offset;
 	PL_max_intro_pending = offset;
+	/* if it's not a simple scalar, replace with an AV or HV */
 	/* XXX DAPM since slot has been allocated, replace
 	 * av_store with PL_curpad[offset] ? */
 	if (*name == '@')
@@ -375,6 +390,9 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
 	else if (*name == '%')
 	    av_store(PL_comppad, offset, (SV*)newHV());
 	SvPADMY_on(PL_curpad[offset]);
+	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+	    "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+	    (long)offset, name, PTR2UV(PL_curpad[offset])));
     }
 
     return offset;
@@ -395,14 +413,20 @@ for a slot which has no name and no active value.
 
 /* XXX DAPM integrate alloc(), add_name() and add_anon(),
  * or at least rationalise ??? */
-
+/* And flag whether the incoming name is UTF8 or 8 bit?
+   Could do this either with the +ve/-ve hack of the HV code, or expanding
+   the flag bits. Either way, this makes proper Unicode safe pad support.
+   NWC
+*/
 
 PADOFFSET
 Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 {
+    dVAR;
     SV *sv;
     I32 retval;
 
+    PERL_UNUSED_ARG(optype);
     ASSERT_CURPAD_ACTIVE("pad_alloc");
 
     if (AvARRAY(PL_comppad) != PL_curpad)
@@ -410,9 +434,7 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     if (PL_pad_reset_pending)
 	pad_reset();
     if (tmptype & SVs_PADMY) {
-	do {
-	    sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
-	} while (SvPADBUSY(sv));		/* need a fresh one */
+	sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
 	retval = AvFILLp(PL_comppad);
     }
     else {
@@ -442,6 +464,10 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 	  "Pad 0x%"UVxf"[0x%"UVxf"] alloc:   %ld for %s\n",
 	  PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
 	  PL_op_name[optype]));
+#ifdef DEBUG_LEAKING_SCALARS
+    sv->sv_debug_optype = optype;
+    sv->sv_debug_inpad = 1;
+#endif
     return (PADOFFSET)retval;
 }
 
@@ -456,12 +482,14 @@ Add an anon code entry to the current compiling pad
 PADOFFSET
 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
+    dVAR;
     PADOFFSET ix;
-    SV* const name = NEWSV(1106, 0);
-    sv_upgrade(name, SVt_PVNV);
+    SV* const name = newSV_type(SVt_PVNV);
+    pad_peg("add_anon");
     sv_setpvn(name, "&", 1);
-    SvIV_set(name, -1);
-    SvNV_set(name, 1);
+    /* Are these two actually ever read? */
+    COP_SEQ_RANGE_HIGH_set(name, ~0);
+    COP_SEQ_RANGE_LOW_set(name, 1);
     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
@@ -495,8 +523,9 @@ C<is_our> indicates that the name to check is an 'our' declaration
 /* XXX DAPM integrate this into pad_add_name ??? */
 
 void
-Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
+Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
 {
+    dVAR;
     SV		**svp;
     PADOFFSET	top, off;
 
@@ -514,16 +543,16 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
 	if (sv
 	    && sv != &PL_sv_undef
 	    && !SvFAKE(sv)
-	    && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-	    && (!is_our
-		|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
+	    && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
 	    && strEQ(name, SvPVX_const(sv)))
 	{
+	    if (is_our && (SvPAD_OUR(sv)))
+		break; /* "our" masking "our" */
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
 		"\"%s\" variable %s masks earlier declaration in same %s",
-		(is_our ? "our" : "my"),
+		(is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
 		name,
-		(SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
+		(COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
 	    --off;
 	    break;
 	}
@@ -535,14 +564,15 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
 	    if (sv
 		&& sv != &PL_sv_undef
 		&& !SvFAKE(sv)
-		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-		&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
+		&& (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
+		&& SvOURSTASH(sv) == ourstash
 		&& strEQ(name, SvPVX_const(sv)))
 	    {
 		Perl_warner(aTHX_ packWARN(WARN_MISC),
 		    "\"our\" variable %s redeclared", name);
-		Perl_warner(aTHX_ packWARN(WARN_MISC),
-		    "\t(Did you mean \"local\" instead of \"our\"?)\n");
+		if ((I32)off <= PL_comppad_name_floor)
+		    Perl_warner(aTHX_ packWARN(WARN_MISC),
+			"\t(Did you mean \"local\" instead of \"our\"?)\n");
 		break;
 	    }
 	} while ( off-- > 0 );
@@ -550,7 +580,6 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
 }
 
 
-
 /*
 =for apidoc pad_findmy
 
@@ -564,260 +593,300 @@ Returns the offset in the current pad, or NOT_IN_PAD on failure.
 */
 
 PADOFFSET
-Perl_pad_findmy(pTHX_ char *name)
+Perl_pad_findmy(pTHX_ const char *name)
 {
-    I32 off;
-    I32 fake_off = 0;
-    I32 our_off = 0;
-    SV *sv;
-    SV **svp = AvARRAY(PL_comppad_name);
-    U32 seq = PL_cop_seqmax;
-
-    ASSERT_CURPAD_ACTIVE("pad_findmy");
-    DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy:  \"%s\"\n", name));
-
-#ifdef USE_5005THREADS
-    /*
-     * Special case to get lexical (and hence per-thread) @_.
-     * XXX I need to find out how to tell at parse-time whether use
-     * of @_ should refer to a lexical (from a sub) or defgv (global
-     * scope and maybe weird sub-ish things like formats). See
-     * startsub in perly.y.  It's possible that @_ could be lexical
-     * (at least from subs) even in non-threaded perl.
-     */
-    if (strEQ(name, "@_"))
-	return 0;		/* success. (NOT_IN_PAD indicates failure) */
-#endif /* USE_5005THREADS */
-
-    /* The one we're looking for is probably just before comppad_name_fill. */
-    for (off = AvFILLp(PL_comppad_name); off > 0; off--) {
-	sv = svp[off];
-	if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX_const(sv), name))
-	    continue;
-	if (SvFAKE(sv)) {
-	    /* we'll use this later if we don't find a real entry */
-	    fake_off = off;
-	    continue;
-	}
-	else {
-	    if (   seq >  U_32(SvNVX(sv))	/* min */
-		&& seq <= (U32)SvIVX(sv))	/* max */
-		return off;
-	    else if ((SvFLAGS(sv) & SVpad_OUR)
-		    && U_32(SvNVX(sv)) == PAD_MAX) /* min */
-	    {
-		/* look for an our that's being introduced; this allows
-		 *    our $foo = 0 unless defined $foo;
-		 * to not give a warning. (Yes, this is a hack) */
-		our_off = off;
-	    }
-	}
+    dVAR;
+    SV *out_sv;
+    int out_flags;
+    I32 offset;
+    const AV *nameav;
+    SV **name_svp;
+
+    pad_peg("pad_findmy");
+    offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
+		NULL, &out_sv, &out_flags);
+    if ((PADOFFSET)offset != NOT_IN_PAD) 
+	return offset;
+
+    /* look for an our that's being introduced; this allows
+     *    our $foo = 0 unless defined $foo;
+     * to not give a warning. (Yes, this is a hack) */
+
+    nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
+    name_svp = AvARRAY(nameav);
+    for (offset = AvFILLp(nameav); offset > 0; offset--) {
+        const SV * const namesv = name_svp[offset];
+	if (namesv && namesv != &PL_sv_undef
+	    && !SvFAKE(namesv)
+	    && (SvPAD_OUR(namesv))
+	    && strEQ(SvPVX_const(namesv), name)
+	    && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */
+	)
+	    return offset;
     }
-    if (fake_off)
-	return fake_off;
-
-    /* See if it's in a nested scope */
-    off = pad_findlex(name, 0, PL_compcv);
-    if (off)			/* pad_findlex returns 0 for failure...*/
-	return off;
-    if (our_off)
-	return our_off;
-    return NOT_IN_PAD;		/* ...but we return NOT_IN_PAD for failure */
-
+    return NOT_IN_PAD;
 }
 
+/*
+ * Returns the offset of a lexical $_, if there is one, at run time.
+ * Used by the UNDERBAR XS macro.
+ */
 
+PADOFFSET
+Perl_find_rundefsvoffset(pTHX)
+{
+    dVAR;
+    SV *out_sv;
+    int out_flags;
+    return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+	    NULL, &out_sv, &out_flags);
+}
 
 /*
 =for apidoc pad_findlex
 
 Find a named lexical anywhere in a chain of nested pads. Add fake entries
-in the inner pads if it's found in an outer one. innercv is the CV *inside*
-the chain of outer CVs to be searched. If newoff is non-null, this is a
-run-time cloning: don't add fake entries, just find the lexical and add a
-ref to it at newoff in the current pad.
+in the inner pads if it's found in an outer one.
+
+Returns the offset in the bottom pad of the lex or the fake lex.
+cv is the CV in which to start the search, and seq is the current cop_seq
+to match against. If warn is true, print appropriate warnings.  The out_*
+vars return values, and so are pointers to where the returned values
+should be stored. out_capture, if non-null, requests that the innermost
+instance of the lexical is captured; out_name_sv is set to the innermost
+matched namesv or fake namesv; out_flags returns the flags normally
+associated with the IVX field of a fake namesv.
+
+Note that pad_findlex() is recursive; it recurses up the chain of CVs,
+then comes back down, adding fake entries as it goes. It has to be this way
+because fake namesvs in anon protoypes have to store in xlow the index into
+the parent pad.
 
 =cut
 */
 
+/* the CV has finished being compiled. This is not a sufficient test for
+ * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */
+#define CvCOMPILED(cv)	CvROOT(cv)
+
+/* the CV does late binding of its lexicals */
+#define CvLATE(cv) (CvANON(cv) || SvTYPE(cv) == SVt_PVFM)
+
+
 STATIC PADOFFSET
-S_pad_findlex(pTHX_ const char *name, PADOFFSET newoff, const CV* innercv)
+S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
+	SV** out_capture, SV** out_name_sv, int *out_flags)
 {
-    CV *cv;
-    I32 off = 0;
-    SV *sv;
-    CV* startcv;
-    U32 seq;
-    I32 depth;
-    AV *oldpad;
-    SV *oldsv;
-    AV *curlist;
-
-    ASSERT_CURPAD_ACTIVE("pad_findlex");
-    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-	"Pad findlex: \"%s\" off=%ld startcv=0x%"UVxf"\n",
-	    name, (long)newoff, PTR2UV(innercv))
-    );
+    dVAR;
+    I32 offset, new_offset;
+    SV *new_capture;
+    SV **new_capturep;
+    const AV * const padlist = CvPADLIST(cv);
 
-    seq = CvOUTSIDE_SEQ(innercv);
-    startcv = CvOUTSIDE(innercv);
+    *out_flags = 0;
 
-    for (cv = startcv; cv; seq = CvOUTSIDE_SEQ(cv), cv = CvOUTSIDE(cv)) {
-	SV **svp;
-	AV *curname;
-	I32 fake_off = 0;
+    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+	"Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
+	PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
 
-	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-	    "             searching: cv=0x%"UVxf" seq=%d\n",
-	    PTR2UV(cv), (int) seq )
-	);
+    /* first, search this pad */
 
-	curlist = CvPADLIST(cv);
-	if (!curlist)
-	    continue; /* an undef CV */
-	svp = av_fetch(curlist, 0, FALSE);
-	if (!svp || *svp == &PL_sv_undef)
-	    continue;
-	curname = (AV*)*svp;
-	svp = AvARRAY(curname);
-
-	depth = CvDEPTH(cv);
-	for (off = AvFILLp(curname); off > 0; off--) {
-	    sv = svp[off];
-	    if (!sv || sv == &PL_sv_undef || !strEQ(SvPVX_const(sv), name))
-		continue;
-	    if (SvFAKE(sv)) {
-		/* we'll use this later if we don't find a real entry */
-		fake_off = off;
-		continue;
-	    }
-	    else {
-		if (   seq >  U_32(SvNVX(sv))	/* min */
-		    && seq <= (U32)SvIVX(sv)	/* max */
-		    && !(newoff && !depth) /* ignore inactive when cloning */
-		)
-		    goto found;
+    if (padlist) { /* not an undef CV */
+	I32 fake_offset = 0;
+        const AV * const nameav = (AV*)AvARRAY(padlist)[0];
+	SV * const * const name_svp = AvARRAY(nameav);
+
+	for (offset = AvFILLp(nameav); offset > 0; offset--) {
+            const SV * const namesv = name_svp[offset];
+	    if (namesv && namesv != &PL_sv_undef
+		    && strEQ(SvPVX_const(namesv), name))
+	    {
+		if (SvFAKE(namesv))
+		    fake_offset = offset; /* in case we don't find a real one */
+		else if (  seq >  COP_SEQ_RANGE_LOW(namesv)	/* min */
+			&& seq <= COP_SEQ_RANGE_HIGH(namesv))	/* max */
+		    break;
 	    }
 	}
 
-	/* no real entry - but did we find a fake one? */
-	if (fake_off) {
-	    if (newoff && !depth)
-		return 0; /* don't clone from inactive stack frame */
-	    off = fake_off;
-	    sv = svp[off];
-	    goto found;
-	}
-    }
-    return 0;
+	if (offset > 0 || fake_offset > 0 ) { /* a match! */
+	    if (offset > 0) { /* not fake */
+		fake_offset = 0;
+		*out_name_sv = name_svp[offset]; /* return the namesv */
+
+		/* set PAD_FAKELEX_MULTI if this lex can have multiple
+		 * instances. For now, we just test !CvUNIQUE(cv), but
+		 * ideally, we should detect my's declared within loops
+		 * etc - this would allow a wider range of 'not stayed
+		 * shared' warnings. We also treated alreadly-compiled
+		 * lexes as not multi as viewed from evals. */
+
+		*out_flags = CvANON(cv) ?
+			PAD_FAKELEX_ANON :
+			    (!CvUNIQUE(cv) && ! CvCOMPILED(cv))
+				? PAD_FAKELEX_MULTI : 0;
+
+		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		    "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n",
+		    PTR2UV(cv), (long)offset,
+		    (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv),
+		    (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv)));
+	    }
+	    else { /* fake match */
+		offset = fake_offset;
+		*out_name_sv = name_svp[offset]; /* return the namesv */
+		*out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv);
+		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		    "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n",
+		    PTR2UV(cv), (long)offset, (unsigned long)*out_flags,
+		    (unsigned long) PARENT_PAD_INDEX(*out_name_sv) 
+		));
+	    }
 
-found:
+	    /* return the lex? */
 
-    if (!depth) 
-	depth = 1;
+	    if (out_capture) {
 
-    oldpad = (AV*)AvARRAY(curlist)[depth];
-    oldsv = *av_fetch(oldpad, off, TRUE);
+		/* our ? */
+		if (SvPAD_OUR(*out_name_sv)) {
+		    *out_capture = NULL;
+		    return offset;
+		}
 
-#ifdef DEBUGGING
-    if (SvFAKE(sv))
-	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		"             matched:   offset %ld"
-		    " FAKE, sv=0x%"UVxf"\n",
-		(long)off,
-		PTR2UV(oldsv)
-	    )
-	);
-    else
-	DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		"             matched:   offset %ld"
-		    " (%lu,%lu), sv=0x%"UVxf"\n",
-		(long)off,
-		(unsigned long)U_32(SvNVX(sv)),
-		(unsigned long)SvIVX(sv),
-		PTR2UV(oldsv)
-	    )
-	);
-#endif
+		/* trying to capture from an anon prototype? */
+		if (CvCOMPILED(cv)
+			? CvANON(cv) && CvCLONE(cv) && !CvCLONED(cv)
+			: *out_flags & PAD_FAKELEX_ANON)
+		{
+		    if (warn && ckWARN(WARN_CLOSURE))
+			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+			    "Variable \"%s\" is not available", name);
+		    *out_capture = NULL;
+		}
 
-    if (!newoff) {		/* Not a mere clone operation. */
-	newoff = pad_add_name(
-	    SvPVX(sv),
-	    (SvFLAGS(sv) & SVpad_TYPED) ? SvSTASH(sv) : Nullhv,
-	    (SvFLAGS(sv) & SVpad_OUR)   ? GvSTASH(sv) : Nullhv,
-	    1  /* fake */
-	);
+		/* real value */
+		else {
+		    int newwarn = warn;
+		    if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
+			 && warn && ckWARN(WARN_CLOSURE)) {
+			newwarn = 0;
+			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+			    "Variable \"%s\" will not stay shared", name);
+		    }
 
-	if (CvANON(PL_compcv) || SvTYPE(PL_compcv) == SVt_PVFM) {
-	    /* "It's closures all the way down." */
-	    CvCLONE_on(PL_compcv);
-	    if (cv == startcv) {
-		if (CvANON(PL_compcv))
-		    oldsv = Nullsv; /* no need to keep ref */
-	    }
-	    else {
-		CV *bcv;
-		for (bcv = startcv;
-		     bcv && bcv != cv && !CvCLONE(bcv);
-		     bcv = CvOUTSIDE(bcv))
-		{
-		    if (CvANON(bcv)) {
-			/* install the missing pad entry in intervening
-			 * nested subs and mark them cloneable. */
-			AV *ocomppad_name = PL_comppad_name;
-			PAD *ocomppad = PL_comppad;
-			AV *padlist = CvPADLIST(bcv);
-			PL_comppad_name = (AV*)AvARRAY(padlist)[0];
-			PL_comppad = (AV*)AvARRAY(padlist)[1];
-			PL_curpad = AvARRAY(PL_comppad);
-			pad_add_name(
-			    SvPVX(sv),
-			    (SvFLAGS(sv) & SVpad_TYPED)
-				? SvSTASH(sv) : Nullhv,
-			    (SvFLAGS(sv) & SVpad_OUR)
-				? GvSTASH(sv) : Nullhv,
-			    1  /* fake */
-			);
-
-			PL_comppad_name = ocomppad_name;
-			PL_comppad = ocomppad;
-			PL_curpad = ocomppad ?
-				AvARRAY(ocomppad) : Null(SV **);
-			CvCLONE_on(bcv);
+		    if (fake_offset && CvANON(cv)
+			    && CvCLONE(cv) &&!CvCLONED(cv))
+		    {
+			SV *n;
+			/* not yet caught - look further up */
+			DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+			    "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
+			    PTR2UV(cv)));
+			n = *out_name_sv;
+			(void) pad_findlex(name, CvOUTSIDE(cv),
+			    CvOUTSIDE_SEQ(cv),
+			    newwarn, out_capture, out_name_sv, out_flags);
+			*out_name_sv = n;
+			return offset;
 		    }
-		    else {
-			if (ckWARN(WARN_CLOSURE)
-			    && !CvUNIQUE(bcv) && !CvUNIQUE(cv))
-			{
+
+		    *out_capture = AvARRAY((AV*)AvARRAY(padlist)[
+				    CvDEPTH(cv) ? CvDEPTH(cv) : 1])[offset];
+		    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+			"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
+			PTR2UV(cv), PTR2UV(*out_capture)));
+
+		    if (SvPADSTALE(*out_capture)) {
+			if (ckWARN(WARN_CLOSURE))
 			    Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-			      "Variable \"%s\" may be unavailable",
-				 name);
-			}
-			break;
+				"Variable \"%s\" is not available", name);
+			*out_capture = NULL;
 		    }
 		}
+		if (!*out_capture) {
+		    if (*name == '@')
+			*out_capture = sv_2mortal((SV*)newAV());
+		    else if (*name == '%')
+			*out_capture = sv_2mortal((SV*)newHV());
+		    else
+			*out_capture = sv_newmortal();
+		}
 	    }
+
+	    return offset;
 	}
-	else if (!CvUNIQUE(PL_compcv)) {
-	    if (ckWARN(WARN_CLOSURE) && !SvFAKE(sv) && !CvUNIQUE(cv)
-		&& !(SvFLAGS(sv) & SVpad_OUR))
-	    {
-		Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-		    "Variable \"%s\" will not stay shared", name);
-	    }
+    }
+
+    /* it's not in this pad - try above */
+
+    if (!CvOUTSIDE(cv))
+	return NOT_IN_PAD;
+
+    /* out_capture non-null means caller wants us to capture lex; in
+     * addition we capture ourselves unless it's an ANON/format */
+    new_capturep = out_capture ? out_capture :
+		CvLATE(cv) ? NULL : &new_capture;
+
+    offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
+		new_capturep, out_name_sv, out_flags);
+    if ((PADOFFSET)offset == NOT_IN_PAD)
+	return NOT_IN_PAD;
+
+    /* found in an outer CV. Add appropriate fake entry to this pad */
+
+    /* don't add new fake entries (via eval) to CVs that we have already
+     * finished compiling, or to undef CVs */
+    if (CvCOMPILED(cv) || !padlist)
+	return 0; /* this dummy (and invalid) value isnt used by the caller */
+
+    {
+	SV *new_namesv;
+	AV *  const ocomppad_name = PL_comppad_name;
+	PAD * const ocomppad = PL_comppad;
+	PL_comppad_name = (AV*)AvARRAY(padlist)[0];
+	PL_comppad = (AV*)AvARRAY(padlist)[1];
+	PL_curpad = AvARRAY(PL_comppad);
+
+	new_offset = pad_add_name(
+	    SvPVX_const(*out_name_sv),
+	    SvPAD_TYPED(*out_name_sv)
+		    ? SvSTASH(*out_name_sv) : NULL,
+	    SvOURSTASH(*out_name_sv),
+	    1,  /* fake */
+	    0   /* not a state variable */
+	);
+
+	new_namesv = AvARRAY(PL_comppad_name)[new_offset];
+	PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
+
+	PARENT_PAD_INDEX_set(new_namesv, 0);
+	if (SvPAD_OUR(new_namesv)) {
+	    NOOP;   /* do nothing */
+	}
+	else if (CvLATE(cv)) {
+	    /* delayed creation - just note the offset within parent pad */
+	    PARENT_PAD_INDEX_set(new_namesv, offset);
+	    CvCLONE_on(cv);
 	}
+	else {
+	    /* immediate creation - capture outer value right now */
+	    av_store(PL_comppad, new_offset, SvREFCNT_inc(*new_capturep));
+	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		"Pad findlex cv=0x%"UVxf" saved captured sv 0x%"UVxf" at offset %ld\n",
+		PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset));
+	}
+	*out_name_sv = new_namesv;
+	*out_flags = PARENT_FAKELEX_FLAGS(new_namesv);
+
+	PL_comppad_name = ocomppad_name;
+	PL_comppad = ocomppad;
+	PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
     }
-    av_store(PL_comppad, newoff, SvREFCNT_inc(oldsv));
-    ASSERT_CURPAD_ACTIVE("pad_findlex 2");
-    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
-		"Pad findlex: set offset %ld to sv 0x%"UVxf"\n",
-		(long)newoff, PTR2UV(oldsv)
-	    )
-    );
-    return newoff;
+    return new_offset;
 }
 
 
+#ifdef DEBUGGING
 /*
 =for apidoc pad_sv
 
@@ -831,12 +900,11 @@ Use macro PAD_SV instead of calling this function directly.
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
+    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_sv");
 
-#ifndef USE_5005THREADS
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_sv po");
-#endif
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 	"Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
 	PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
@@ -854,10 +922,10 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 =cut
 */
 
-#ifdef DEBUGGING
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
+    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_setsv");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
@@ -887,6 +955,7 @@ Update the pad compilation state variables on entry to a new block
 void
 Perl_pad_block_start(pTHX_ int full)
 {
+    dVAR;
     ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
@@ -915,6 +984,7 @@ Perl_pad_block_start(pTHX_ int full)
 U32
 Perl_intro_my(pTHX)
 {
+    dVAR;
     SV **svp;
     I32 i;
 
@@ -926,13 +996,14 @@ Perl_intro_my(pTHX)
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
 	SV * const sv = svp[i];
 
-	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !SvIVX(sv)) {
-	    SvIV_set(sv, PAD_MAX);	/* Don't know scope end yet. */
-	    SvNV_set(sv, (NV)PL_cop_seqmax);
+	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !COP_SEQ_RANGE_HIGH(sv)) {
+	    COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX);	/* Don't know scope end yet. */
+	    COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
 	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		"Pad intromy: %ld \"%s\", (%lu,%lu)\n",
 		(long)i, SvPVX_const(sv),
-		(unsigned long)U_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
+		(unsigned long)COP_SEQ_RANGE_LOW(sv),
+		(unsigned long)COP_SEQ_RANGE_HIGH(sv))
 	    );
 	}
     }
@@ -956,6 +1027,7 @@ lexicals in this scope and warn of any lexicals that never got introduced.
 void
 Perl_pad_leavemy(pTHX)
 {
+    dVAR;
     I32 off;
     SV * const * const svp = AvARRAY(PL_comppad_name);
 
@@ -968,18 +1040,20 @@ Perl_pad_leavemy(pTHX)
 	    if (sv && sv != &PL_sv_undef
 		    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
 		Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-					"%"SVf" never introduced", sv);
+			    "%"SVf" never introduced",
+			    SVfARG(sv));
 	}
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
 	const SV * const sv = svp[off];
-	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX) {
-	    SvIV_set(sv, PL_cop_seqmax);
+	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PAD_MAX) {
+	    COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
 	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		"Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
 		(long)off, SvPVX_const(sv),
-		(unsigned long)U_32(SvNVX(sv)), (unsigned long)SvIVX(sv))
+		(unsigned long)COP_SEQ_RANGE_LOW(sv),
+		(unsigned long)COP_SEQ_RANGE_HIGH(sv))
 	    );
 	}
     }
@@ -1001,6 +1075,7 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
+    dVAR;
     ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
 	return;
@@ -1022,7 +1097,7 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     /* if pad tmps aren't shared between ops, then there's no need to
      * create a new tmp when an existing op is freed */
 #ifdef USE_BROKEN_PAD_RESET
-    PL_curpad[po] = NEWSV(1107,0);
+    PL_curpad[po] = newSV(0);
     SvPADTMP_on(PL_curpad[po]);
 #else
     PL_curpad[po] = &PL_sv_undef;
@@ -1049,6 +1124,7 @@ Mark all the current temporaries for reuse
 void
 Perl_pad_reset(pTHX)
 {
+    dVAR;
 #ifdef USE_BROKEN_PAD_RESET
     if (AvARRAY(PL_comppad) != PL_curpad)
 	Perl_croak(aTHX_ "panic: pad_reset curpad");
@@ -1092,15 +1168,40 @@ Tidy up a pad after we've finished compiling it:
 void
 Perl_pad_tidy(pTHX_ padtidy_type type)
 {
+    dVAR;
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
+
+    /* If this CV has had any 'eval-capable' ops planted in it
+     * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
+     * anon prototypes in the chain of CVs should be marked as cloneable,
+     * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
+     * the right CvOUTSIDE.
+     * If running with -d, *any* sub may potentially have an eval
+     * excuted within it.
+     */
+
+    if (PL_cv_has_eval || PL_perldb) {
+        const CV *cv;
+	for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
+	    if (cv != PL_compcv && CvCOMPILED(cv))
+		break; /* no need to mark already-compiled code */
+	    if (CvANON(cv)) {
+		DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+		    "Pad clone on cv=0x%"UVxf"\n", PTR2UV(cv)));
+		CvCLONE_on(cv);
+	    }
+	}
+    }
+
     /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
-	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
+	av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
 
     if (type == padtidy_SUBCLONE) {
 	SV * const * const namep = AvARRAY(PL_comppad_name);
 	PADOFFSET ix;
+
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    SV *namesv;
 
@@ -1108,16 +1209,15 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 		continue;
 	    /*
 	     * The only things that a clonable function needs in its
-	     * pad are references to outer lexicals and anonymous subs.
+	     * pad are anonymous subs.
 	     * The rest are created anew during cloning.
 	     */
-	    if (!((namesv = namep[ix]) != Nullsv &&
+	    if (!((namesv = namep[ix]) != NULL &&
 		  namesv != &PL_sv_undef &&
-		  (SvFAKE(namesv) ||
-		   *SvPVX_const(namesv) == '&')))
+		   *SvPVX_const(namesv) == '&'))
 	    {
 		SvREFCNT_dec(PL_curpad[ix]);
-		PL_curpad[ix] = Nullsv;
+		PL_curpad[ix] = NULL;
 	    }
 	}
     }
@@ -1126,7 +1226,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 	AV * const av = newAV();			/* Will be @_ */
 	av_extend(av, 0);
 	av_store(PL_comppad, 0, (SV*)av);
-	AvFLAGS(av) = AVf_REIFY;
+	AvREIFY_only(av);
     }
 
     /* XXX DAPM rationalise these two similar branches */
@@ -1163,6 +1263,7 @@ Free the SV at offset po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
+    dVAR;
     ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
 	return;
@@ -1180,10 +1281,15 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 	SvPADTMP_off(PL_curpad[po]);
 #ifdef USE_ITHREADS
 	/* SV could be a shared hash key (eg bugid #19022) */
-	if (!SvFAKE(PL_curpad[po]))
+	if (
+#ifdef PERL_OLD_COPY_ON_WRITE
+	    !SvIsCOW(PL_curpad[po])
+#else
+	    !SvFAKE(PL_curpad[po])
+#endif
+	    )
 	    SvREADONLY_off(PL_curpad[po]);	/* could be a freed constant */
 #endif
-
     }
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
@@ -1202,6 +1308,7 @@ Dump the contents of a padlist
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
+    dVAR;
     const AV *pad_name;
     const AV *pad;
     SV **pname;
@@ -1223,16 +1330,19 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
         const SV *namesv = pname[ix];
 	if (namesv && namesv == &PL_sv_undef) {
-	    namesv = Nullsv;
+	    namesv = NULL;
 	}
 	if (namesv) {
 	    if (SvFAKE(namesv))
 		Perl_dump_indent(aTHX_ level+1, file,
-		    "%2d. 0x%"UVxf"<%lu> FAKE \"%s\"\n",
+		    "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
 		    (int) ix,
 		    PTR2UV(ppad[ix]),
 		    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
-		    SvPVX_const(namesv)
+		    SvPVX_const(namesv),
+		    (unsigned long)PARENT_FAKELEX_FLAGS(namesv),
+		    (unsigned long)PARENT_PAD_INDEX(namesv)
+
 		);
 	    else
 		Perl_dump_indent(aTHX_ level+1, file,
@@ -1240,8 +1350,8 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 		    (int) ix,
 		    PTR2UV(ppad[ix]),
 		    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
-		    (unsigned long)U_32(SvNVX(namesv)),
-		    (unsigned long)SvIVX(namesv),
+		    (unsigned long)COP_SEQ_RANGE_LOW(namesv),
+		    (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
 		    SvPVX_const(namesv)
 		);
 	}
@@ -1270,6 +1380,7 @@ dump the contents of a CV
 STATIC void
 S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
+    dVAR;
     const CV * const outside = CvOUTSIDE(cv);
     AV* const padlist = CvPADLIST(cv);
 
@@ -1278,6 +1389,7 @@ S_cv_dump(pTHX_ const CV *cv, const char *title)
 		  title,
 		  PTR2UV(cv),
 		  (CvANON(cv) ? "ANON"
+		   : (SvTYPE(cv) == SVt_PVFM) ? "FORMAT"
 		   : (cv == PL_main_cv) ? "MAIN"
 		   : CvUNIQUE(cv) ? "UNIQUE"
 		   : CvGV(cv) ? GvNAME(CvGV(cv)) : "UNDEFINED"),
@@ -1311,22 +1423,7 @@ any outer lexicals.
 CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
-    CV *cv;
-
-    LOCK_CRED_MUTEX;			/* XXX create separate mutex */
-    cv = cv_clone2(proto, CvOUTSIDE(proto));
-    UNLOCK_CRED_MUTEX;			/* XXX create separate mutex */
-    return cv;
-}
-
-
-/* XXX DAPM separate out cv and paddish bits ???
- * ideally the CV-related stuff shouldn't be in pad.c - how about
- * a cv.c? */
-
-STATIC CV *
-S_cv_clone2(pTHX_ CV *proto, CV *outside)
-{
+    dVAR;
     I32 ix;
     AV* const protopadlist = CvPADLIST(proto);
     const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
@@ -1336,25 +1433,35 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
     CV* cv;
+    SV** outpad;
+    CV* outside;
+    long depth;
 
     assert(!CvUNIQUE(proto));
 
+    /* Since cloneable anon subs can be nested, CvOUTSIDE may point
+     * to a prototype; we instead want the cloned parent who called us.
+     * Note that in general for formats, CvOUTSIDE != find_runcv */
+
+    outside = CvOUTSIDE(proto);
+    if (outside && CvCLONE(outside) && ! CvCLONED(outside))
+	outside = find_runcv(NULL);
+    depth = CvDEPTH(outside);
+    assert(depth || SvTYPE(proto) == SVt_PVFM);
+    if (!depth)
+	depth = 1;
+    assert(CvPADLIST(outside));
+
     ENTER;
     SAVESPTR(PL_compcv);
 
-    cv = PL_compcv = (CV*)NEWSV(1104, 0);
-    sv_upgrade((SV *)cv, SvTYPE(proto));
+    cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto));
     CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE);
     CvCLONED_on(cv);
 
-#ifdef USE_5005THREADS
-    New(666, CvMUTEXP(cv), 1, perl_mutex);
-    MUTEX_INIT(CvMUTEXP(cv));
-    CvOWNER(cv)		= 0;
-#endif /* USE_5005THREADS */
 #ifdef USE_ITHREADS
-    CvFILE(cv)		= CvXSUB(proto) ? CvFILE(proto)
-					: savepv(CvFILE(proto));
+    CvFILE(cv)		= CvISXSUB(proto) ? CvFILE(proto)
+					  : savepv(CvFILE(proto));
 #else
     CvFILE(cv)		= CvFILE(proto);
 #endif
@@ -1364,79 +1471,65 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
     OP_REFCNT_UNLOCK;
     CvSTART(cv)		= CvSTART(proto);
-    if (outside) {
-	CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
-	CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
-    }
+    CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc_simple(outside);
+    CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))
 	sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
 
     CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
+    av_fill(PL_comppad, fpad);
     for (ix = fname; ix >= 0; ix--)
 	av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
 
-    av_fill(PL_comppad, fpad);
     PL_curpad = AvARRAY(PL_comppad);
 
+    outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
+
     for (ix = fpad; ix > 0; ix--) {
-	SV* const namesv = (ix <= fname) ? pname[ix] : Nullsv;
-	if (namesv && namesv != &PL_sv_undef) {
-	    const char *name = SvPVX_const(namesv);    /* XXX */
-	    if (SvFLAGS(namesv) & SVf_FAKE) {   /* lexical from outside? */
-		I32 off = pad_findlex(name, ix, cv);
-		if (!off)
-		    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
-		else if (off != ix)
-		    Perl_croak(aTHX_ "panic: cv_clone: %s", name);
+	SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
+	SV *sv = NULL;
+	if (namesv && namesv != &PL_sv_undef) { /* lexical */
+	    if (SvFAKE(namesv)) {   /* lexical from outside? */
+		sv = outpad[PARENT_PAD_INDEX(namesv)];
+		assert(sv);
+		/* formats may have an inactive parent */
+		if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
+		    if (ckWARN(WARN_CLOSURE))
+			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
+			    "Variable \"%s\" is not available", SvPVX_const(namesv));
+		    sv = NULL;
+		}
+		/* 'my $x if $y' can leave $x stale even in an active sub */
+		else if (!SvPADSTALE(sv)) {
+		    SvREFCNT_inc_simple_void_NN(sv);
+		}
 	    }
-	    else {				/* our own lexical */
-		SV* sv;
-		if (*name == '&') {
-		    /* anon code -- we'll come back for it */
+	    if (!sv) {
+                const char sigil = SvPVX_const(namesv)[0];
+                if (sigil == '&')
 		    sv = SvREFCNT_inc(ppad[ix]);
-		}
-		else if (*name == '@')
+                else if (sigil == '@')
 		    sv = (SV*)newAV();
-		else if (*name == '%')
+                else if (sigil == '%')
 		    sv = (SV*)newHV();
 		else
-		    sv = NEWSV(0, 0);
-		if (!SvPADBUSY(sv))
-		    SvPADMY_on(sv);
-		PL_curpad[ix] = sv;
+		    sv = newSV(0);
+		SvPADMY_on(sv);
+		/* reset the 'assign only once' flag on each state var */
+		if (SvPAD_STATE(namesv))
+		    SvPADSTALE_on(sv);
 	    }
 	}
 	else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
-	    PL_curpad[ix] = SvREFCNT_inc(ppad[ix]);
+	    sv = SvREFCNT_inc_NN(ppad[ix]);
 	}
 	else {
-	    SV* sv = NEWSV(0, 0);
+	    sv = newSV(0);
 	    SvPADTMP_on(sv);
-	    PL_curpad[ix] = sv;
-	}
-    }
-
-    /* Now that vars are all in place, clone nested closures. */
-
-    for (ix = fpad; ix > 0; ix--) {
-	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
-	if (namesv
-	    && namesv != &PL_sv_undef
-	    && !(SvFLAGS(namesv) & SVf_FAKE)
-	    && *SvPVX(namesv) == '&'
-	    && CvCLONE(ppad[ix]))
-	{
-	    CV *kid = cv_clone2((CV*)ppad[ix], cv);
-	    SvREFCNT_dec(ppad[ix]);
-	    CvCLONE_on(kid);
-	    SvPADMY_on(kid);
-	    PL_curpad[ix] = (SV*)kid;
-	    /* '&' entry points to child, so child mustn't refcnt parent */
-	    CvWEAKOUTSIDE_on(kid);
-	    SvREFCNT_dec(cv);
 	}
+	PL_curpad[ix] = sv;
     }
 
     DEBUG_Xv(
@@ -1449,11 +1542,19 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside)
     LEAVE;
 
     if (CvCONST(cv)) {
+	/* Constant sub () { $x } closing over $x - see lib/constant.pm:
+	 * The prototype was marked as a candiate for const-ization,
+	 * so try to grab the current const value, and if successful,
+	 * turn into a const sub:
+	 */
 	SV* const const_sv = op_const_sv(CvSTART(cv), cv);
-	assert(const_sv);
-	/* constant sub () { $x } closing over $x - see lib/constant.pm */
-	SvREFCNT_dec(cv);
-	cv = newCONSTSUB(CvSTASH(proto), Nullch, const_sv);
+	if (const_sv) {
+	    SvREFCNT_dec(cv);
+	    cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
+	}
+	else {
+	    CvCONST_off(cv);
+	}
     }
 
     return cv;
@@ -1473,11 +1574,14 @@ moved to a pre-existing CV struct.
 void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
+    dVAR;
     I32 ix;
     AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
     AV * const comppad = (AV*)AvARRAY(padlist)[1];
     SV ** const namepad = AvARRAY(comppad_name);
     SV ** const curpad = AvARRAY(comppad);
+    PERL_UNUSED_ARG(old_cv);
+
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV * const namesv = namepad[ix];
 	if (namesv && namesv != &PL_sv_undef
@@ -1496,61 +1600,62 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 =for apidoc pad_push
 
 Push a new pad frame onto the padlist, unless there's already a pad at
-this depth, in which case don't bother creating a new one.
-If has_args is true, give the new pad an @_ in slot zero.
+this depth, in which case don't bother creating a new one.  Then give
+the new pad an @_ in slot zero.
 
 =cut
 */
 
-/* XXX pad_push is now always called with has_args == 1. Get rid of
- * this arg at some point */
-
 void
-Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
+Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 {
-    if (depth <= AvFILLp(padlist))
-	return;
-
-    {
+    dVAR;
+    if (depth > AvFILLp(padlist)) {
 	SV** const svp = AvARRAY(padlist);
 	AV* const newpad = newAV();
 	SV** const oldpad = AvARRAY(svp[depth-1]);
 	I32 ix = AvFILLp((AV*)svp[1]);
-	I32 names_fill = AvFILLp((AV*)svp[0]);
+        const I32 names_fill = AvFILLp((AV*)svp[0]);
 	SV** const names = AvARRAY(svp[0]);
-	SV* sv;
+	AV *av;
+
 	for ( ;ix > 0; ix--) {
 	    if (names_fill >= ix && names[ix] != &PL_sv_undef) {
-		const char *name = SvPVX_const(names[ix]);
-		if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
+		const char sigil = SvPVX_const(names[ix])[0];
+		if ((SvFLAGS(names[ix]) & SVf_FAKE)
+			|| (SvFLAGS(names[ix]) & SVpad_STATE)
+			|| sigil == '&')
+		{
 		    /* outer lexical or anon code */
 		    av_store(newpad, ix, SvREFCNT_inc(oldpad[ix]));
 		}
 		else {		/* our own lexical */
-		    if (*name == '@')
-			av_store(newpad, ix, sv = (SV*)newAV());
-		    else if (*name == '%')
-			av_store(newpad, ix, sv = (SV*)newHV());
+		    SV *sv; 
+		    if (sigil == '@')
+			sv = (SV*)newAV();
+		    else if (sigil == '%')
+			sv = (SV*)newHV();
 		    else
-			av_store(newpad, ix, sv = NEWSV(0, 0));
+			sv = newSV(0);
+		    av_store(newpad, ix, sv);
 		    SvPADMY_on(sv);
 		}
 	    }
 	    else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
-		av_store(newpad, ix, sv = SvREFCNT_inc(oldpad[ix]));
+		av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
 	    }
 	    else {
 		/* save temporaries on recursion? */
-		av_store(newpad, ix, sv = NEWSV(0, 0));
+		SV * const sv = newSV(0);
+		av_store(newpad, ix, sv);
 		SvPADTMP_on(sv);
 	    }
 	}
-	if (has_args) {
-	    AV* av = newAV();
-	    av_extend(av, 0);
-	    av_store(newpad, 0, (SV*)av);
-	    AvFLAGS(av) = AVf_REIFY;
-	}
+	av = newAV();
+	av_extend(av, 0);
+	av_store(newpad, 0, (SV*)av);
+	AvREIFY_only(av);
+
 	av_store(padlist, depth, (SV*)newpad);
 	AvFILLp(padlist) = depth;
     }
@@ -1560,11 +1665,12 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
 HV *
 Perl_pad_compname_type(pTHX_ const PADOFFSET po)
 {
+    dVAR;
     SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
-    if ( SvFLAGS(*av) & SVpad_TYPED ) {
+    if ( SvPAD_TYPED(*av) ) {
         return SvSTASH(*av);
     }
-    return Nullhv;
+    return NULL;
 }
 
 /*