X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=2cff24dc955b7c17665710b0f91b129df6dc2740;hb=ef469b0369ad36d7b41ff4e3416ffb34105b3bef;hp=001b3042cc37e12545296e14990de41157b84441;hpb=1d3259712a05143b33614901d9fae89e4bbfaa3e;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/pad.c b/pad.c
index 001b304..2cff24d 100644
--- a/pad.c
+++ b/pad.c
@@ -176,7 +176,7 @@ 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 {
 	av_store(pad, 0, Nullsv);
@@ -257,17 +257,20 @@ Perl_pad_undef(pTHX_ CV* cv)
 	for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
 	    SV *namesv = namepad[ix];
 	    if (namesv && namesv != &PL_sv_undef
-		&& *SvPVX(namesv) == '&')
+		&& *SvPVX_const(namesv) == '&')
 	    {
 		CV * const innercv = (CV*)curpad[ix];
+		U32 inner_rc = SvREFCNT(innercv);
+		assert(inner_rc);
 		namepad[ix] = Nullsv;
 		SvREFCNT_dec(namesv);
 
 		if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/  */
 		    curpad[ix] = Nullsv;
 		    SvREFCNT_dec(innercv);
+		    inner_rc--;
 		}
-		if (SvREFCNT(innercv) /* in use, not just a prototype */
+		if (inner_rc /* in use, not just a prototype */
 		    && CvOUTSIDE(innercv) == cv)
 		{
 		    assert(CvWEAKOUTSIDE(innercv));
@@ -337,7 +340,7 @@ Perl_pad_add_name(pTHX_ const 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;
@@ -352,8 +355,8 @@ Perl_pad_add_name(pTHX_ const 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;
@@ -458,8 +461,8 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     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[] ? */
@@ -514,7 +517,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
 	    && (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)))
 	{
 	    Perl_warner(aTHX_ packWARN(WARN_MISC),
 		"\"%s\" variable %s masks earlier declaration in same %s",
@@ -533,7 +536,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
 		&& !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);
@@ -583,7 +586,7 @@ Perl_pad_findmy(pTHX_ const char *name)
 	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;
@@ -666,7 +669,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 	for (offset = AvFILLp(nameav); offset > 0; offset--) {
             const SV *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 */
@@ -813,7 +816,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
 	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)
@@ -822,15 +825,15 @@ S_pad_findlex(pTHX_ const char *name, const 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 {
@@ -959,11 +962,11 @@ Perl_intro_my(pTHX)
 	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;
+	    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))
 	    );
 	}
@@ -1009,10 +1012,10 @@ Perl_pad_leavemy(pTHX)
 	if ((sv = svp[off]) && sv != &PL_sv_undef
 		&& !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
 	{
-	    SvIVX(sv) = PL_cop_seqmax;
+	    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))
 	    );
 	}
@@ -1119,6 +1122,7 @@ Tidy up a pad after we've finished compiling it:
 void
 Perl_pad_tidy(pTHX_ padtidy_type type)
 {
+    dVAR;
     PADOFFSET ix;
 
     ASSERT_CURPAD_ACTIVE("pad_tidy");
@@ -1164,7 +1168,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;
@@ -1176,7 +1180,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 	AV *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 */
@@ -1285,7 +1289,7 @@ 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),
-		    SvPVX(namesv),
+		    SvPVX_const(namesv),
 		    (unsigned long)SvIVX(namesv),
 		    (unsigned long)SvNVX(namesv)
 
@@ -1298,7 +1302,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) {
@@ -1368,6 +1372,7 @@ any outer lexicals.
 CV *
 Perl_cv_clone(pTHX_ CV *proto)
 {
+    dVAR;
     I32 ix;
     AV* protopadlist = CvPADLIST(proto);
     const AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
@@ -1376,7 +1381,6 @@ Perl_cv_clone(pTHX_ CV *proto)
     SV** ppad = AvARRAY(protopad);
     const I32 fname = AvFILLp(protopad_name);
     const I32 fpad = AvFILLp(protopad);
-    AV* comppadlist;
     CV* cv;
     SV** outpad;
     CV* outside;
@@ -1421,9 +1425,9 @@ Perl_cv_clone(pTHX_ CV *proto)
     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--)
@@ -1444,7 +1448,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 {
@@ -1453,7 +1457,7 @@ Perl_cv_clone(pTHX_ CV *proto)
 		}
 	    }
 	    if (!sv) {
-                const char sigil = SvPVX(namesv)[0];
+                const char sigil = SvPVX_const(namesv)[0];
                 if (sigil == '&')
 		    sv = SvREFCNT_inc(ppad[ix]);
                 else if (sigil == '@')
@@ -1525,7 +1529,7 @@ Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
     for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
         const SV *namesv = namepad[ix];
 	if (namesv && namesv != &PL_sv_undef
-	    && *SvPVX(namesv) == '&')
+	    && *SvPVX_const(namesv) == '&')
 	{
 	    CV *innercv = (CV*)curpad[ix];
 	    assert(CvWEAKOUTSIDE(innercv));
@@ -1563,7 +1567,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 
 	for ( ;ix > 0; ix--) {
 	    if (names_fill >= ix && names[ix] != &PL_sv_undef) {
-		const char sigil = SvPVX(names[ix])[0];
+		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]));
@@ -1593,9 +1597,30 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
 	av = newAV();
 	av_extend(av, 0);
 	av_store(newpad, 0, (SV*)av);
-	AvFLAGS(av) = AVf_REIFY;
+	AvREIFY_only(av);
 
 	av_store(padlist, depth, (SV*)newpad);
 	AvFILLp(padlist) = depth;
     }
 }
+
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+    SV** 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:
+ */