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
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()).
{
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.
AvFLAGS(a0) = AVf_REIFY;
}
else {
-#ifdef USE_5005THREADS
- av_store(padname, 0, newSVpvn("@_", 2));
- a0 = newAV();
- SvPADMY_on((SV*)a0); /* XXX Needed? */
- av_store(pad, 0, (SV*)a0);
-#else
av_store(pad, 0, Nullsv);
-#endif /* USE_THREADS */
}
AvREAL_off(padlist);
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);
SV* namesv = NEWSV(1102, 0);
U32 min, max;
+ ASSERT_CURPAD_ACTIVE("pad_add_name");
+
if (fake) {
min = PL_curcop->cop_seq;
max = PAD_MAX;
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 == '%')
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)
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;
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 */
PERL_CONTEXT *cx;
CV *outside;
+ 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--) {
if ((sv = svp[off]) &&
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",
/* 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];
PL_comppad_name = ocomppad_name;
PL_comppad = ocomppad;
- PL_curpad = ocurpad;
+ PL_curpad = ocomppad ?
+ AvARRAY(ocomppad) : Null(SV **);
CvCLONE_on(bcv);
}
else {
}
}
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)
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");
-#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(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];
}
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;
}
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)
SV *sv;
I32 i;
+ ASSERT_CURPAD_ACTIVE("intro_my");
if (! PL_min_intro_pending)
return PL_cop_seqmax;
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))
void
Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
{
+ ASSERT_CURPAD_LEGAL("pad_swipe");
if (!PL_curpad)
return;
if (AvARRAY(PL_comppad) != PL_curpad)
{
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);
SvPADTMP_on(PL_curpad[ix]);
}
}
+ PL_curpad = AvARRAY(PL_comppad);
}
void
Perl_pad_free(pTHX_ PADOFFSET po)
{
+ ASSERT_CURPAD_LEGAL("pad_free");
if (!PL_curpad)
return;
if (AvARRAY(PL_comppad) != PL_curpad)
CvFLAGS(cv) = CvFLAGS(proto) & ~CVf_CLONE;
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));
projects / p5sagit/p5-mst-13.2.git / blobdiff