X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=590aad8d153f48d091d1cd61d2e3fc779332b50a;hb=53df3d8cb98cbfbef669eddaaa174212d27bd68c;hp=96da712c2d5e8d4da0860939fc1b776b788bbbcd;hpb=dd2155a49b710f23bc6d72169e5b1d71d8b3aa03;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index 96da712..590aad8 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 is set the the the names AV. C is set the the frame AV for the frame CvDEPTH == 1. C 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 and C 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. @@ -119,8 +124,7 @@ Perl_pad_new(pTHX_ padnew_flags flags) /* save existing state, ... */ if (flags & padnew_SAVE) { - SAVEVPTR(PL_curpad); - SAVESPTR(PL_comppad); + SAVECOMPPAD(); SAVESPTR(PL_comppad_name); if (! (flags & padnew_CLONE)) { SAVEI32(PL_padix); @@ -153,14 +157,7 @@ Perl_pad_new(pTHX_ padnew_flags flags) 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); @@ -257,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); @@ -299,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; @@ -337,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 == '%') @@ -370,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) @@ -431,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; @@ -458,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 */ @@ -527,21 +532,9 @@ 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)); -#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]) && @@ -605,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", @@ -689,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]; @@ -706,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 { @@ -732,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) @@ -810,21 +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"); -#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]; } @@ -843,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; } @@ -876,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) @@ -907,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; @@ -948,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)) @@ -984,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) @@ -1070,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); @@ -1120,6 +1108,7 @@ Perl_pad_tidy(pTHX_ padtidy_type type) SvPADTMP_on(PL_curpad[ix]); } } + PL_curpad = AvARRAY(PL_comppad); } @@ -1135,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) @@ -1315,11 +1305,6 @@ S_cv_clone2(pTHX_ CV *proto, CV *outside) 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));