X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/00b1698f76403476df2006ff536ab00ffc650220..a1cac82e623c5bbb331e6465011c5b46dfbfc277:/pad.c diff --git a/pad.c b/pad.c index 880902d..3b52c20 100644 --- a/pad.c +++ b/pad.c @@ -74,10 +74,10 @@ in PL_op->op_targ), wasting a name SV for them doesn't make sense. 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 lexicals, the type is SVt_PVGV, and GvSTASH points at the -stash of the associated global (so that duplicate C declarations in the -same package can be detected). SvCUR is sometimes hijacked to -store the generation number during compilation. +type. For C lexicals, the type is also SVt_PVGV, with the MAGIC slot +pointing at the stash of the associated global (so that duplicate C +declarations in the same package can be detected). SvCUR is sometimes +hijacked to store the generation number during compilation. If SvFAKE is set on the name SV, then that slot in the frame AV is a REFCNT'ed reference to a lexical from "outside". In this case, @@ -109,11 +109,17 @@ to be generated in evals, such as #include "EXTERN.h" #define PERL_IN_PAD_C #include "perl.h" +#include "keywords.h" #define PAD_MAX 999999999 - +#ifdef PERL_MAD +void pad_peg(const char* s) { + static int pegcnt; + pegcnt++; +} +#endif /* =for apidoc pad_new @@ -233,6 +239,7 @@ Perl_pad_undef(pTHX_ CV* cv) I32 ix; const PADLIST * const padlist = CvPADLIST(cv); + pad_peg("pad_undef"); if (!padlist) return; if (SvIS_FREED(padlist)) /* may be during global destruction */ @@ -272,37 +279,35 @@ Perl_pad_undef(pTHX_ CV* cv) SvREFCNT_dec(innercv); inner_rc--; } - if (inner_rc /* in use, not just a prototype */ - && CvOUTSIDE(innercv) == cv) - { + + /* in use, not just a prototype */ + if (inner_rc && (CvOUTSIDE(innercv) == cv)) { assert(CvWEAKOUTSIDE(innercv)); /* 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); + SvREFCNT_inc_simple_void_NN(outercv); } else { CvOUTSIDE(innercv) = NULL; } - } - } } } ix = AvFILLp(padlist); while (ix >= 0) { - SV* const sv = AvARRAY(padlist)[ix--]; - if (!sv) - continue; - if (sv == (SV*)PL_comppad_name) - PL_comppad_name = NULL; - else if (sv == (SV*)PL_comppad) { - PL_comppad = Null(PAD*); - PL_curpad = Null(SV**); + const SV* const sv = AvARRAY(padlist)[ix--]; + if (sv) { + if (sv == (SV*)PL_comppad_name) + PL_comppad_name = NULL; + else if (sv == (SV*)PL_comppad) { + PL_comppad = NULL; + PL_curpad = NULL; + } } SvREFCNT_dec(sv); } @@ -321,7 +326,7 @@ offset. If C is valid, the name is for a typed lexical; set the name's stash to that value. If C is valid, it's an our lexical, set the name's -GvSTASH to that value +OURSTASH to that value If fake, it means we're cloning an existing entry @@ -329,7 +334,7 @@ If fake, it means we're cloning an existing entry */ PADOFFSET -Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake) +Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake, bool state) { dVAR; const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY); @@ -338,17 +343,20 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake ASSERT_CURPAD_ACTIVE("pad_add_name"); - sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV); + sv_upgrade(namesv, (ourstash || typestash) ? SVt_PVMG : SVt_PVNV); sv_setpv(namesv, name); if (typestash) { SvPAD_TYPED_on(namesv); - SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash)); + SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash)); } if (ourstash) { SvPAD_OUR_on(namesv); - GvSTASH(namesv) = ourstash; - Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv); + OURSTASH_set(namesv, ourstash); + SvREFCNT_inc_simple_void_NN(ourstash); + } + else if (state) { + SvPAD_STATE_on(namesv); } av_store(PL_comppad_name, offset, namesv); @@ -470,6 +478,7 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) dVAR; PADOFFSET ix; SV* const name = newSV(0); + pad_peg("add_anon"); sv_upgrade(name, SVt_PVNV); sv_setpvn(name, "&", 1); SvIV_set(name, -1); @@ -534,7 +543,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) break; /* "our" masking "our" */ Perl_warner(aTHX_ packWARN(WARN_MISC), "\"%s\" variable %s masks earlier declaration in same %s", - (is_our ? "our" : "my"), + (is_our ? "our" : PL_in_my == KEY_my ? "my" : "state"), name, (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); --off; @@ -549,7 +558,7 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) && sv != &PL_sv_undef && !SvFAKE(sv) && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) - && ((SvPAD_OUR(sv)) && GvSTASH(sv) == ourstash) + && OURSTASH(sv) == ourstash && strEQ(name, SvPVX_const(sv))) { Perl_warner(aTHX_ packWARN(WARN_MISC), @@ -586,9 +595,10 @@ Perl_pad_findmy(pTHX_ const char *name) const AV *nameav; SV **name_svp; - offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1, + pad_peg("pad_findmy"); + offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1, NULL, &out_sv, &out_flags); - if (offset != NOT_IN_PAD) + if ((PADOFFSET)offset != NOT_IN_PAD) return offset; /* look for an our that's being introduced; this allows @@ -808,7 +818,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, if (!CvOUTSIDE(cv)) return NOT_IN_PAD; - + /* out_capture non-null means caller wants us to capture lex; in * addition we capture ourselves unless it's an ANON/format */ new_capturep = out_capture ? out_capture : @@ -816,9 +826,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1, new_capturep, out_name_sv, out_flags); - if (offset == NOT_IN_PAD) + if ((PADOFFSET)offset == NOT_IN_PAD) return NOT_IN_PAD; - + /* found in an outer CV. Add appropriate fake entry to this pad */ /* don't add new fake entries (via eval) to CVs that we have already @@ -838,9 +848,9 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SvPVX_const(*out_name_sv), SvPAD_TYPED(*out_name_sv) ? SvSTASH(*out_name_sv) : NULL, - SvPAD_OUR(*out_name_sv) - ? GvSTASH(*out_name_sv) : NULL, - 1 /* fake */ + OURSTASH(*out_name_sv), + 1, /* fake */ + 0 /* not a state variable */ ); new_namesv = AvARRAY(PL_comppad_name)[new_offset]; @@ -848,7 +858,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, SvNV_set(new_namesv, (NV)0); if (SvPAD_OUR(new_namesv)) { - /*EMPTY*/; /* do nothing */ + NOOP; /* do nothing */ } else if (CvLATE(cv)) { /* delayed creation - just note the offset within parent pad */ @@ -1026,7 +1036,8 @@ Perl_pad_leavemy(pTHX) if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && ckWARN_d(WARN_INTERNAL)) Perl_warner(aTHX_ packWARN(WARN_INTERNAL), - "%"SVf" never introduced", sv); + "%"SVf" never introduced", + (void*)sv); } } /* "Deintroduce" my variables that are leaving with this scope. */ @@ -1456,7 +1467,7 @@ Perl_cv_clone(pTHX_ CV *proto) CvROOT(cv) = OpREFCNT_inc(CvROOT(proto)); OP_REFCNT_UNLOCK; CvSTART(cv) = CvSTART(proto); - CvOUTSIDE(cv) = (CV*)SvREFCNT_inc(outside); + CvOUTSIDE(cv) = (CV*)SvREFCNT_inc_simple(outside); CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto); if (SvPOK(proto)) @@ -1488,7 +1499,7 @@ Perl_cv_clone(pTHX_ CV *proto) } else { assert(!SvPADSTALE(sv)); - sv = SvREFCNT_inc(sv); + SvREFCNT_inc_simple_void_NN(sv); } } if (!sv) { @@ -1505,7 +1516,7 @@ Perl_cv_clone(pTHX_ CV *proto) } } else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) { - sv = SvREFCNT_inc(ppad[ix]); + sv = SvREFCNT_inc_NN(ppad[ix]); } else { sv = newSV(0); @@ -1592,10 +1603,7 @@ void Perl_pad_push(pTHX_ PADLIST *padlist, int depth) { dVAR; - if (depth <= AvFILLp(padlist)) - return; - - { + if (depth > AvFILLp(padlist)) { SV** const svp = AvARRAY(padlist); AV* const newpad = newAV(); SV** const oldpad = AvARRAY(svp[depth-1]); @@ -1624,7 +1632,7 @@ Perl_pad_push(pTHX_ PADLIST *padlist, int depth) } } else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) { - av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); + av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix])); } else { /* save temporaries on recursion? */