X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/2affe78f01f9cd3aae1b214beb9140e1fe830c7d..3b1f0a7d76b88895b5c128cb6c38057a63c5084b:/pad.c

diff --git a/pad.c b/pad.c
index 90d9979..4d87758 100644
--- a/pad.c
+++ b/pad.c
@@ -1,6 +1,6 @@
 /*    pad.c
  *
- *    Copyright (C) 2002,2003 by Larry Wall and others
+ *    Copyright (C) 2002, 2003, 2004, 2005 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.
@@ -22,6 +22,11 @@
 /*
 =head1 Pad Data Structures
 
+This file contains the functions that create and manipulate scratchpads,
+which are array-of-array data structures attached to a CV (ie a sub)
+and which store lexical variables and opcode temporary and per-thread
+values.
+
 =for apidoc m|AV *|CvPADLIST|CV *cv
 CV's can have CvPADLIST(cv) set to point to an AV.
 
@@ -70,7 +75,7 @@ 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> delarations in 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.
 
@@ -91,6 +96,12 @@ 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 
+
+    { my $x = 1; sub f { eval '$x'} } f();
+
 =cut
 */
 
@@ -121,7 +132,7 @@ can be OR'ed together:
 PADLIST *
 Perl_pad_new(pTHX_ int flags)
 {
-    AV *padlist, *padname, *pad, *a0;
+    AV *padlist, *padname, *pad;
 
     ASSERT_CURPAD_LEGAL("pad_new");
 
@@ -162,10 +173,10 @@ Perl_pad_new(pTHX_ int flags)
 	 * dispensed with eventually ???
 	 */
 
-	a0 = newAV();			/* will be @_ */
+        AV * const a0 = newAV();			/* will be @_ */
 	av_extend(a0, 0);
 	av_store(pad, 0, (SV*)a0);
-	AvFLAGS(a0) = AVf_REIFY;
+	AvREIFY_only(a0);
     }
     else {
 	av_store(pad, 0, Nullsv);
@@ -218,7 +229,7 @@ void
 Perl_pad_undef(pTHX_ CV* cv)
 {
     I32 ix;
-    PADLIST *padlist = CvPADLIST(cv);
+    const PADLIST * const padlist = CvPADLIST(cv);
 
     if (!padlist)
 	return;
@@ -237,38 +248,52 @@ Perl_pad_undef(pTHX_ CV* cv)
      * children, or integrate this loop with general cleanup */
 
     if (!PL_dirty) { /* don't bother during global destruction */
-	CV *outercv = CvOUTSIDE(cv);
-	U32 seq = CvOUTSIDE_SEQ(cv);
-	AV *comppad_name = (AV*)AvARRAY(padlist)[0];
-	SV **namepad = AvARRAY(comppad_name);
-	AV *comppad = (AV*)AvARRAY(padlist)[1];
-	SV **curpad = AvARRAY(comppad);
+	CV * const outercv = CvOUTSIDE(cv);
+        const U32 seq = CvOUTSIDE_SEQ(cv);
+	AV *  const comppad_name = (AV*)AvARRAY(padlist)[0];
+	SV ** const namepad = AvARRAY(comppad_name);
+	AV *  const comppad = (AV*)AvARRAY(padlist)[1];
+	SV ** const curpad = AvARRAY(comppad);
 	for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-	    SV *namesv = namepad[ix];
+	    SV * const namesv = namepad[ix];
 	    if (namesv && namesv != &PL_sv_undef
-		&& *SvPVX(namesv) == '&')
+		&& *SvPVX_const(namesv) == '&')
 	    {
-		CV *innercv = (CV*)curpad[ix];
+		CV * const innercv = (CV*)curpad[ix];
+		U32 inner_rc = SvREFCNT(innercv);
+		assert(inner_rc);
 		namepad[ix] = Nullsv;
 		SvREFCNT_dec(namesv);
-		curpad[ix] = Nullsv;
-		SvREFCNT_dec(innercv);
-		if (SvREFCNT(innercv) /* in use, not just a prototype */
+
+		if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
+		    curpad[ix] = Nullsv;
+		    SvREFCNT_dec(innercv);
+		    inner_rc--;
+		}
+		if (inner_rc /* in use, not just a prototype */
 		    && CvOUTSIDE(innercv) == cv)
 		{
 		    assert(CvWEAKOUTSIDE(innercv));
-		    CvWEAKOUTSIDE_off(innercv);
-		    CvOUTSIDE(innercv) = outercv;
-		    CvOUTSIDE_SEQ(innercv) = seq;
-		    SvREFCNT_inc(outercv);
+		    /* 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);
+		    }
+		    else {
+			CvOUTSIDE(innercv) = Nullcv;
+		    }
+
 		}
+
 	    }
 	}
     }
 
     ix = AvFILLp(padlist);
     while (ix >= 0) {
-	SV* sv = AvARRAY(padlist)[ix--];
+	SV* const sv = AvARRAY(padlist)[ix--];
 	if (!sv)
 	    continue;
 	if (sv == (SV*)PL_comppad_name)
@@ -302,10 +327,10 @@ If fake, it means we're cloning an existing entry
 */
 
 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)
 {
-    PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
-    SV* namesv = NEWSV(1102, 0);
+    const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+    SV* const namesv = NEWSV(1102, 0);
 
     ASSERT_CURPAD_ACTIVE("pad_add_name");
 
@@ -315,11 +340,12 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
 
     if (typestash) {
 	SvFLAGS(namesv) |= SVpad_TYPED;
-	SvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) typestash);
+	SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash));
     }
     if (ourstash) {
 	SvFLAGS(namesv) |= SVpad_OUR;
-	GvSTASH(namesv) = (HV*)SvREFCNT_inc((SV*) ourstash);
+	GvSTASH(namesv) = ourstash;
+	Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv);
     }
 
     av_store(PL_comppad_name, offset, namesv);
@@ -330,8 +356,8 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
     }
     else {
 	/* not yet introduced */
-	SvNVX(namesv) = (NV)PAD_MAX;	/* min */
-	SvIVX(namesv) = 0;		/* max */
+	SvNV_set(namesv, (NV)PAD_MAX);	/* min */
+	SvIV_set(namesv, 0);		/* max */
 
 	if (!PL_min_intro_pending)
 	    PL_min_intro_pending = offset;
@@ -360,7 +386,7 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
 
 Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
 the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
-for a slot which has no name and and no active value.
+for a slot which has no name and no active value.
 
 =cut
 */
@@ -386,8 +412,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
 	retval = AvFILLp(PL_comppad);
     }
     else {
-	SV **names = AvARRAY(PL_comppad_name);
-	SSize_t names_fill = AvFILLp(PL_comppad_name);
+	SV * const * const names = AvARRAY(PL_comppad_name);
+        const SSize_t names_fill = AvFILLp(PL_comppad_name);
 	for (;;) {
 	    /*
 	     * "foreach" index vars temporarily become aliases to non-"my"
@@ -412,6 +438,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;
 }
 
@@ -427,13 +457,11 @@ PADOFFSET
 Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
 {
     PADOFFSET ix;
-    SV* name;
-
-    name = NEWSV(1106, 0);
+    SV* const name = NEWSV(1106, 0);
     sv_upgrade(name, SVt_PVNV);
     sv_setpvn(name, "&", 1);
-    SvIVX(name) = -1;
-    SvNVX(name) = 1;
+    SvIV_set(name, -1);
+    SvNV_set(name, 1);
     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
     /* XXX DAPM use PL_curpad[] ? */
@@ -467,13 +495,13 @@ 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)
 {
-    SV		**svp, *sv;
+    SV		**svp;
     PADOFFSET	top, off;
 
     ASSERT_CURPAD_ACTIVE("pad_check_dup");
-    if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
+    if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
 	return; /* nothing to check */
 
     svp = AvARRAY(PL_comppad_name);
@@ -482,14 +510,15 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
     /* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
      * type ? */
     for (off = top; (I32)off > PL_comppad_name_floor; off--) {
-	if ((sv = svp[off])
+	SV * const sv = svp[off];
+	if (sv
 	    && sv != &PL_sv_undef
 	    && !SvFAKE(sv)
 	    && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
-	    && (!is_our
-		|| ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
-	    && strEQ(name, SvPVX(sv)))
+	    && strEQ(name, SvPVX_const(sv)))
 	{
+	    if (is_our && (SvFLAGS(sv) & SVpad_OUR))
+		break; /* "our" masking "our" */
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
 		"\"%s\" variable %s masks earlier declaration in same %s",
 		(is_our ? "our" : "my"),
@@ -502,17 +531,19 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
     /* check the rest of the pad */
     if (is_our) {
 	do {
-	    if ((sv = svp[off])
+	    SV * const sv = svp[off];
+	    if (sv
 		&& sv != &PL_sv_undef
 		&& !SvFAKE(sv)
 		&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
 		&& ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
-		&& strEQ(name, SvPVX(sv)))
+		&& 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 );
@@ -533,12 +564,12 @@ 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)
 {
     SV *out_sv;
     int out_flags;
     I32 offset;
-    AV *nameav;
+    const AV *nameav;
     SV **name_svp;
 
     offset =  pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
@@ -553,11 +584,11 @@ Perl_pad_findmy(pTHX_ char *name)
     nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
     name_svp = AvARRAY(nameav);
     for (offset = AvFILLp(nameav); offset > 0; offset--) {
-	SV *namesv = name_svp[offset];
+        const SV * const namesv = name_svp[offset];
 	if (namesv && namesv != &PL_sv_undef
 	    && !SvFAKE(namesv)
 	    && (SvFLAGS(namesv) & SVpad_OUR)
-	    && strEQ(SvPVX(namesv), name)
+	    && strEQ(SvPVX_const(namesv), name)
 	    && U_32(SvNVX(namesv)) == PAD_MAX /* min */
 	)
 	    return offset;
@@ -565,6 +596,19 @@ Perl_pad_findmy(pTHX_ char *name)
     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)
+{
+    SV *out_sv;
+    int out_flags;
+    return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+	    Null(SV**), &out_sv, &out_flags);
+}
 
 /*
 =for apidoc pad_findlex
@@ -603,13 +647,13 @@ the parent pad.
 
 
 STATIC PADOFFSET
-S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
+S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 	SV** out_capture, SV** out_name_sv, int *out_flags)
 {
     I32 offset, new_offset;
     SV *new_capture;
     SV **new_capturep;
-    AV *padlist = CvPADLIST(cv);
+    const AV * const padlist = CvPADLIST(cv);
 
     *out_flags = 0;
 
@@ -621,13 +665,13 @@ S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
 
     if (padlist) { /* not an undef CV */
 	I32 fake_offset = 0;
-	AV *nameav = (AV*)AvARRAY(padlist)[0];
-	SV **name_svp = AvARRAY(nameav);
+        const AV * const nameav = (AV*)AvARRAY(padlist)[0];
+	SV * const * const name_svp = AvARRAY(nameav);
 
 	for (offset = AvFILLp(nameav); offset > 0; offset--) {
-	    SV *namesv = name_svp[offset];
+            const SV * const namesv = name_svp[offset];
 	    if (namesv && namesv != &PL_sv_undef
-		    && strEQ(SvPVX(namesv), name))
+		    && strEQ(SvPVX_const(namesv), name))
 	    {
 		if (SvFAKE(namesv))
 		    fake_offset = offset; /* in case we don't find a real one */
@@ -710,7 +754,8 @@ S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
 			    "Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
 			    PTR2UV(cv)));
 			n = *out_name_sv;
-			pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
+			(void) pad_findlex(name, CvOUTSIDE(cv),
+			    CvOUTSIDE_SEQ(cv),
 			    newwarn, out_capture, out_name_sv, out_flags);
 			*out_name_sv = n;
 			return offset;
@@ -767,14 +812,14 @@ S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
 
     {
 	SV *new_namesv;
-	AV *ocomppad_name = PL_comppad_name;
-	PAD *ocomppad = PL_comppad;
+	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(*out_name_sv),
+	    SvPVX_const(*out_name_sv),
 	    (SvFLAGS(*out_name_sv) & SVpad_TYPED)
 		    ? SvSTASH(*out_name_sv) : Nullhv,
 	    (SvFLAGS(*out_name_sv) & SVpad_OUR)
@@ -783,15 +828,15 @@ S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
 	);
 
 	new_namesv = AvARRAY(PL_comppad_name)[new_offset];
-	SvIVX(new_namesv) = *out_flags;
+	SvIV_set(new_namesv, *out_flags);
 
-	SvNVX(new_namesv) = (NV)0;
+	SvNV_set(new_namesv, (NV)0);
 	if (SvFLAGS(new_namesv) & SVpad_OUR) {
 	   /* do nothing */
 	}
 	else if (CvLATE(cv)) {
 	    /* delayed creation - just note the offset within parent pad */
-	    SvNVX(new_namesv) = (NV)offset;
+	    SvNV_set(new_namesv, (NV)offset);
 	    CvCLONE_on(cv);
 	}
 	else {
@@ -908,7 +953,6 @@ U32
 Perl_intro_my(pTHX)
 {
     SV **svp;
-    SV *sv;
     I32 i;
 
     ASSERT_CURPAD_ACTIVE("intro_my");
@@ -917,14 +961,14 @@ Perl_intro_my(pTHX)
 
     svp = AvARRAY(PL_comppad_name);
     for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
-	if ((sv = svp[i]) && sv != &PL_sv_undef
-		&& !SvFAKE(sv) && !SvIVX(sv))
-	{
-	    SvIVX(sv) = PAD_MAX;	/* Don't know scope end yet. */
-	    SvNVX(sv) = (NV)PL_cop_seqmax;
+	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);
 	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		"Pad intromy: %ld \"%s\", (%ld,%ld)\n",
-		(long)i, SvPVX(sv),
+		(long)i, SvPVX_const(sv),
 		(long)U_32(SvNVX(sv)), (long)SvIVX(sv))
 	    );
 	}
@@ -950,15 +994,15 @@ void
 Perl_pad_leavemy(pTHX)
 {
     I32 off;
-    SV **svp = AvARRAY(PL_comppad_name);
-    SV *sv;
+    SV * const * const svp = AvARRAY(PL_comppad_name);
 
     PL_pad_reset_pending = FALSE;
 
     ASSERT_CURPAD_ACTIVE("pad_leavemy");
     if (PL_min_intro_pending && PL_comppad_name_fill < PL_min_intro_pending) {
 	for (off = PL_max_intro_pending; off >= PL_min_intro_pending; off--) {
-	    if ((sv = svp[off]) && sv != &PL_sv_undef
+	    const SV * const sv = svp[off];
+	    if (sv && sv != &PL_sv_undef
 		    && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL))
 		Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
 					"%"SVf" never introduced", sv);
@@ -966,13 +1010,12 @@ Perl_pad_leavemy(pTHX)
     }
     /* "Deintroduce" my variables that are leaving with this scope. */
     for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
-	if ((sv = svp[off]) && sv != &PL_sv_undef
-		&& !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
-	{
-	    SvIVX(sv) = PL_cop_seqmax;
+	const SV * const sv = svp[off];
+	if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX) {
+	    SvIV_set(sv, PL_cop_seqmax);
 	    DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 		"Pad leavemy: %ld \"%s\", (%ld,%ld)\n",
-		(long)off, SvPVX(sv),
+		(long)off, SvPVX_const(sv),
 		(long)U_32(SvNVX(sv)), (long)SvIVX(sv))
 	    );
 	}
@@ -1012,8 +1055,15 @@ Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
     if (refadjust)
 	SvREFCNT_dec(PL_curpad[po]);
 
+
+    /* 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);
     SvPADTMP_on(PL_curpad[po]);
+#else
+    PL_curpad[po] = &PL_sv_undef;
+#endif
     if ((I32)po < PL_padix)
 	PL_padix = po - 1;
 }
@@ -1037,8 +1087,6 @@ void
 Perl_pad_reset(pTHX)
 {
 #ifdef USE_BROKEN_PAD_RESET
-    register I32 po;
-
     if (AvARRAY(PL_comppad) != PL_curpad)
 	Perl_croak(aTHX_ "panic: pad_reset curpad");
 
@@ -1050,6 +1098,7 @@ Perl_pad_reset(pTHX)
     );
 
     if (!PL_tainting) {	/* Can't mix tainted and non-tainted temporaries. */
+        register I32 po;
 	for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
 	    if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
 		SvPADTMP_off(PL_curpad[po]);
@@ -1080,8 +1129,7 @@ Tidy up a pad after we've finished compiling it:
 void
 Perl_pad_tidy(pTHX_ padtidy_type type)
 {
-    PADOFFSET ix;
-    CV *cv;
+    dVAR;
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
 
@@ -1095,6 +1143,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
      */
 
     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 */
@@ -1111,7 +1160,8 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
 
     if (type == padtidy_SUBCLONE) {
-	SV **namep = AvARRAY(PL_comppad_name);
+	SV * const * const namep = AvARRAY(PL_comppad_name);
+	PADOFFSET ix;
 
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    SV *namesv;
@@ -1125,7 +1175,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 	     */
 	    if (!((namesv = namep[ix]) != Nullsv &&
 		  namesv != &PL_sv_undef &&
-		   *SvPVX(namesv) == '&'))
+		   *SvPVX_const(namesv) == '&'))
 	    {
 		SvREFCNT_dec(PL_curpad[ix]);
 		PL_curpad[ix] = Nullsv;
@@ -1134,15 +1184,16 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
     }
     else if (type == padtidy_SUB) {
 	/* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
-	AV *av = newAV();			/* Will be @_ */
+	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 */
 
     if (type == padtidy_SUB) {
+	PADOFFSET ix;
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
 		continue;
@@ -1151,6 +1202,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 	}
     }
     else if (type == padtidy_FORMAT) {
+	PADOFFSET ix;
 	for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
 	    if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
 		SvPADTMP_on(PL_curpad[ix]);
@@ -1163,7 +1215,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 /*
 =for apidoc pad_free
 
-Free the SV at offet po in the current pad.
+Free the SV at offset po in the current pad.
 
 =cut
 */
@@ -1190,7 +1242,7 @@ Perl_pad_free(pTHX_ PADOFFSET po)
 #ifdef USE_ITHREADS
 	/* SV could be a shared hash key (eg bugid #19022) */
 	if (
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
 	    !SvIsCOW(PL_curpad[po])
 #else
 	    !SvFAKE(PL_curpad[po])
@@ -1216,11 +1268,10 @@ Dump the contents of a padlist
 void
 Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 {
-    AV *pad_name;
-    AV *pad;
+    const AV *pad_name;
+    const AV *pad;
     SV **pname;
     SV **ppad;
-    SV *namesv;
     I32 ix;
 
     if (!padlist) {
@@ -1236,18 +1287,18 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
     );
 
     for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
-	namesv = pname[ix];
+        const SV *namesv = pname[ix];
 	if (namesv && namesv == &PL_sv_undef) {
 	    namesv = Nullsv;
 	}
 	if (namesv) {
 	    if (SvFAKE(namesv))
 		Perl_dump_indent(aTHX_ level+1, file,
-		    "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%x index=%lu\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(namesv),
+		    SvPVX_const(namesv),
 		    (unsigned long)SvIVX(namesv),
 		    (unsigned long)SvNVX(namesv)
 
@@ -1260,7 +1311,7 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
 		    (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
 		    (long)U_32(SvNVX(namesv)),
 		    (long)SvIVX(namesv),
-		    SvPVX(namesv)
+		    SvPVX_const(namesv)
 		);
 	}
 	else if (full) {
@@ -1286,10 +1337,10 @@ dump the contents of a CV
 
 #ifdef DEBUGGING
 STATIC void
-S_cv_dump(pTHX_ CV *cv, char *title)
+S_cv_dump(pTHX_ const CV *cv, const char *title)
 {
-    CV *outside = CvOUTSIDE(cv);
-    AV* padlist = CvPADLIST(cv);
+    const CV * const outside = CvOUTSIDE(cv);
+    AV* const padlist = CvPADLIST(cv);
 
     PerlIO_printf(Perl_debug_log,
 		  "  %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
@@ -1330,15 +1381,15 @@ any outer lexicals.
 CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
+    dVAR;
     I32 ix;
-    AV* protopadlist = CvPADLIST(proto);
-    AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
-    AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
-    SV** pname = AvARRAY(protopad_name);
-    SV** ppad = AvARRAY(protopad);
-    I32 fname = AvFILLp(protopad_name);
-    I32 fpad = AvFILLp(protopad);
-    AV* comppadlist;
+    AV* const protopadlist = CvPADLIST(proto);
+    const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
+    const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+    SV** const pname = AvARRAY(protopad_name);
+    SV** const ppad = AvARRAY(protopad);
+    const I32 fname = AvFILLp(protopad_name);
+    const I32 fpad = AvFILLp(protopad);
     CV* cv;
     SV** outpad;
     CV* outside;
@@ -1375,15 +1426,17 @@ Perl_cv_clone(pTHX_ CV *proto)
 #endif
     CvGV(cv)		= CvGV(proto);
     CvSTASH(cv)		= CvSTASH(proto);
+    OP_REFCNT_LOCK;
     CvROOT(cv)		= OpREFCNT_inc(CvROOT(proto));
+    OP_REFCNT_UNLOCK;
     CvSTART(cv)		= CvSTART(proto);
     CvOUTSIDE(cv)	= (CV*)SvREFCNT_inc(outside);
     CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
 
     if (SvPOK(proto))
-	sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
+	sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
 
-    CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
+    CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
 
     av_fill(PL_comppad, fpad);
     for (ix = fname; ix >= 0; ix--)
@@ -1394,7 +1447,7 @@ Perl_cv_clone(pTHX_ CV *proto)
     outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
 
     for (ix = fpad; ix > 0; ix--) {
-	SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
+	SV* const namesv = (ix <= fname) ? pname[ix] : Nullsv;
 	SV *sv = Nullsv;
 	if (namesv && namesv != &PL_sv_undef) { /* lexical */
 	    if (SvFAKE(namesv)) {   /* lexical from outside? */
@@ -1404,7 +1457,7 @@ Perl_cv_clone(pTHX_ CV *proto)
 		if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) {
 		    if (ckWARN(WARN_CLOSURE))
 			Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
-			    "Variable \"%s\" is not available", SvPVX(namesv));
+			    "Variable \"%s\" is not available", SvPVX_const(namesv));
 		    sv = Nullsv;
 		}
 		else {
@@ -1413,12 +1466,12 @@ Perl_cv_clone(pTHX_ CV *proto)
 		}
 	    }
 	    if (!sv) {
-		char *name = SvPVX(namesv);
-		if (*name == '&')
+                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);
@@ -1450,10 +1503,10 @@ Perl_cv_clone(pTHX_ CV *proto)
 	 * so try to grab the current const value, and if successful,
 	 * turn into a const sub:
 	 */
-	SV* const_sv = op_const_sv(CvSTART(cv), cv);
+	SV* const const_sv = op_const_sv(CvSTART(cv), cv);
 	if (const_sv) {
 	    SvREFCNT_dec(cv);
-	    cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
+	    cv = newCONSTSUB(CvSTASH(proto), Nullch, const_sv);
 	}
 	else {
 	    CvCONST_off(cv);
@@ -1478,16 +1531,16 @@ void
 Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
 {
     I32 ix;
-    AV *comppad_name = (AV*)AvARRAY(padlist)[0];
-    AV *comppad = (AV*)AvARRAY(padlist)[1];
-    SV **namepad = AvARRAY(comppad_name);
-    SV **curpad = AvARRAY(comppad);
+    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);
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
-	SV *namesv = namepad[ix];
+        const SV * const namesv = namepad[ix];
 	if (namesv && namesv != &PL_sv_undef
-	    && *SvPVX(namesv) == '&')
+	    && *SvPVX_const(namesv) == '&')
 	{
-	    CV *innercv = (CV*)curpad[ix];
+	    CV * const innercv = (CV*)curpad[ix];
 	    assert(CvWEAKOUTSIDE(innercv));
 	    assert(CvOUTSIDE(innercv) == old_cv);
 	    CvOUTSIDE(innercv) = new_cv;
@@ -1500,59 +1553,83 @@ 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
 */
 
 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;
 
     {
-	SV** svp = AvARRAY(padlist);
-	AV *newpad = newAV();
-	SV **oldpad = AvARRAY(svp[depth-1]);
+	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]);
-	SV** names = AvARRAY(svp[0]);
-	SV* sv;
+        const I32 names_fill = AvFILLp((AV*)svp[0]);
+	SV** const names = AvARRAY(svp[0]);
+	AV *av;
+
 	for ( ;ix > 0; ix--) {
 	    if (names_fill >= ix && names[ix] != &PL_sv_undef) {
-		char *name = SvPVX(names[ix]);
-		if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
+		const char sigil = SvPVX_const(names[ix])[0];
+		if ((SvFLAGS(names[ix]) & SVf_FAKE) || 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, 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(oldpad[ix]));
 	    }
 	    else {
 		/* save temporaries on recursion? */
-		av_store(newpad, ix, sv = NEWSV(0, 0));
+		SV * const sv = NEWSV(0, 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;
     }
 }
+
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+    SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
+    if ( SvFLAGS(*av) & SVpad_TYPED ) {
+        return SvSTASH(*av);
+    }
+    return Nullhv;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */