PL_curpad == AvARRAY(PL_comppad) always

Message-ID: <20021018133640.A19172@fdgroup.com>

p4raw-id: //depot/perl@18048

1 files changed, 33 insertions, 20 deletions

diff --git a/pad.c b/pad.c
index e79110fdc7..590aad8d15 100644
--- a/pad.c
+++ b/pad.c
@@ -34,7 +34,7 @@ but that is really the callers pad (a slot of which is allocated by
 every entersub).
 
 The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in op.c) rather than normal av.c rules.
+is managed "manual" (mostly in pad.c) rather than normal av.c rules.
 The items in the AV are not SVs as for a normal AV, but other AVs:
 
 0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
@@ -50,7 +50,10 @@ C<PL_comppad_name> is set the the the names AV.
 C<PL_comppad> is set the the frame AV for the frame CvDEPTH == 1.
 C<PL_curpad> is set the body of the frame AV (i.e. AvARRAY(PL_comppad)).
 
-Itterating over the names AV itterates over all possible pad
+During execution, C<PL_comppad> and C<PL_curpad> refer to the live
+frame of the currently executing sub.
+
+Iterating over the names AV iterates over all possible pad
 items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
 &PL_sv_undef "names" (see pad_alloc()).
 
@@ -110,6 +113,8 @@ Perl_pad_new(pTHX_ padnew_flags flags)
 {
     AV *padlist, *padname, *pad, *a0;
 
+    ASSERT_CURPAD_LEGAL("pad_new");
+
     /* XXX DAPM really need a new SAVEt_PAD which restores all or most
      * vars (based on flags) rather than storing vals + addresses for
      * each individually. Also see pad_block_start.
@@ -249,7 +254,7 @@ Perl_pad_undef(pTHX_ CV* cv, CV* outercv)
 	if (sv == (SV*)PL_comppad_name)
 	    PL_comppad_name = Nullav;
 	else if (sv == (SV*)PL_comppad) {
-	    PL_comppad = Nullav;
+	    PL_comppad = Null(PAD*);
 	    PL_curpad = Null(SV**);
 	}
 	SvREFCNT_dec(sv);
@@ -291,6 +296,8 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
     SV* namesv = NEWSV(1102, 0);
     U32 min, max;
 
+    ASSERT_CURPAD_ACTIVE("pad_add_name");
+
     if (fake) {
 	min = PL_curcop->cop_seq;
 	max = PAD_MAX;
@@ -329,6 +336,8 @@ Perl_pad_add_name(pTHX_ char *name, HV* typestash, HV* ourstash, bool fake)
 	if (!PL_min_intro_pending)
 	    PL_min_intro_pending = offset;
 	PL_max_intro_pending = offset;
+	/* XXX DAPM since slot has been allocated, replace
+	 * av_store with PL_curpad[offset] ? */
 	if (*name == '@')
 	    av_store(PL_comppad, offset, (SV*)newAV());
 	else if (*name == '%')
@@ -362,6 +371,8 @@ Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
     SV *sv;
     I32 retval;
 
+    ASSERT_CURPAD_ACTIVE("pad_alloc");
+
     if (AvARRAY(PL_comppad) != PL_curpad)
 	Perl_croak(aTHX_ "panic: pad_alloc");
     if (PL_pad_reset_pending)
@@ -423,6 +434,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
     SvNVX(name) = 1;
     ix = pad_alloc(op_type, SVs_PADMY);
     av_store(PL_comppad_name, ix, name);
+    /* XXX DAPM use PL_curpad[] ? */
     av_store(PL_comppad, ix, sv);
     SvPADMY_on(sv);
     return ix;
@@ -450,6 +462,7 @@ Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
     SV		**svp, *sv;
     PADOFFSET	top, off;
 
+    ASSERT_CURPAD_ACTIVE("pad_check_dup");
     if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
 	return; /* nothing to check */
 
@@ -519,6 +532,7 @@ Perl_pad_findmy(pTHX_ char *name)
     PERL_CONTEXT *cx;
     CV *outside;
 
+    ASSERT_CURPAD_ACTIVE("pad_findmy");
     DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findmy:  \"%s\"\n", name));
 
     /* The one we're looking for is probably just before comppad_name_fill. */
@@ -584,6 +598,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
     register I32 i;
     register PERL_CONTEXT *cx;
 
+    ASSERT_CURPAD_ACTIVE("pad_findlex");
     DEBUG_Xv(PerlIO_printf(Perl_debug_log,
 	"Pad findlex: \"%s\" off=%ld seq=%lu cv=0x%"UVxf
 	    " ix=%ld saweval=%d flags=%lu\n",
@@ -668,8 +683,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 				/* install the missing pad entry in intervening
 				 * nested subs and mark them cloneable. */
 				AV *ocomppad_name = PL_comppad_name;
-				AV *ocomppad = PL_comppad;
-				SV **ocurpad = PL_curpad;
+				PAD *ocomppad = PL_comppad;
 				AV *padlist = CvPADLIST(bcv);
 				PL_comppad_name = (AV*)AvARRAY(padlist)[0];
 				PL_comppad = (AV*)AvARRAY(padlist)[1];
@@ -685,7 +699,8 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 
 				PL_comppad_name = ocomppad_name;
 				PL_comppad = ocomppad;
-				PL_curpad = ocurpad;
+				PL_curpad = ocomppad ?
+				    	AvARRAY(ocomppad) : Null(SV **);
 				CvCLONE_on(bcv);
 			    }
 			    else {
@@ -711,6 +726,7 @@ S_pad_findlex(pTHX_ char *name, PADOFFSET newoff, U32 seq, CV* startcv,
 		}
 	    }
 	    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)
@@ -789,19 +805,13 @@ Use macro PAD_SV instead of calling this function directly.
 SV *
 Perl_pad_sv(pTHX_ PADOFFSET po)
 {
-#ifdef DEBUGGING
-    /* for display purposes, try to guess the AV corresponding to
-     * Pl_curpad */
-    AV *cp = PL_comppad;
-    if (cp && AvARRAY(cp) != PL_curpad)
-	cp = Nullav;
-#endif
+    ASSERT_CURPAD_ACTIVE("pad_sv");
 
     if (!po)
 	Perl_croak(aTHX_ "panic: pad_sv po");
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 	"Pad 0x%"UVxf"[0x%"UVxf"] sv:      %ld sv=0x%"UVxf"\n",
-	PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
+	PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(PL_curpad[po]))
     );
     return PL_curpad[po];
 }
@@ -820,15 +830,11 @@ Use the macro PAD_SETSV() rather than calling this function directly.
 void
 Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
 {
-    /* for display purposes, try to guess the AV corresponding to
-     * Pl_curpad */
-    AV *cp = PL_comppad;
-    if (cp && AvARRAY(cp) != PL_curpad)
-	cp = Nullav;
+    ASSERT_CURPAD_ACTIVE("pad_setsv");
 
     DEBUG_X(PerlIO_printf(Perl_debug_log,
 	"Pad 0x%"UVxf"[0x%"UVxf"] setsv:   %ld sv=0x%"UVxf"\n",
-	PTR2UV(cp), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
+	PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po, PTR2UV(sv))
     );
     PL_curpad[po] = sv;
 }
@@ -853,6 +859,7 @@ Update the pad compilation state variables on entry to a new block
 void
 Perl_pad_block_start(pTHX_ int full)
 {
+    ASSERT_CURPAD_ACTIVE("pad_block_start");
     SAVEI32(PL_comppad_name_floor);
     PL_comppad_name_floor = AvFILLp(PL_comppad_name);
     if (full)
@@ -884,6 +891,7 @@ Perl_intro_my(pTHX)
     SV *sv;
     I32 i;
 
+    ASSERT_CURPAD_ACTIVE("intro_my");
     if (! PL_min_intro_pending)
 	return PL_cop_seqmax;
 
@@ -925,6 +933,7 @@ Perl_pad_leavemy(pTHX)
 
     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 && ckWARN_d(WARN_INTERNAL))
@@ -961,6 +970,7 @@ new one.
 void
 Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
 {
+    ASSERT_CURPAD_LEGAL("pad_swipe");
     if (!PL_curpad)
 	return;
     if (AvARRAY(PL_comppad) != PL_curpad)
@@ -1047,6 +1057,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 {
     PADOFFSET ix;
 
+    ASSERT_CURPAD_ACTIVE("pad_tidy");
     /* extend curpad to match namepad */
     if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
 	av_store(PL_comppad_name, AvFILLp(PL_comppad), Nullsv);
@@ -1097,6 +1108,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type)
 		SvPADTMP_on(PL_curpad[ix]);
 	}
     }
+    PL_curpad = AvARRAY(PL_comppad);
 }
 
 
@@ -1112,6 +1124,7 @@ Free the SV at offet po in the current pad.
 void
 Perl_pad_free(pTHX_ PADOFFSET po)
 {
+    ASSERT_CURPAD_LEGAL("pad_free");
     if (!PL_curpad)
 	return;
     if (AvARRAY(PL_comppad) != PL_curpad)