X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=pad.c;h=44fafb67eadd30e23263967ce556fdc53c95f89a;hb=3b9a98565e2d390457228bfe912ab7ca457a1c60;hp=aa806ea95ae99d45ccda81897a175eefde5dc1d4;hpb=4608196e45589eea5792cff92b551109899ddb06;p=p5sagit%2Fp5-mst-13.2.git diff --git a/pad.c b/pad.c index aa806ea..44fafb6 100644 --- a/pad.c +++ b/pad.c @@ -1,6 +1,6 @@ /* pad.c * - * Copyright (C) 2002, 2003, 2004, 2005, 2006, by Larry Wall and others + * Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007 by Larry Wall and others * * You may distribute under the terms of either the GNU General Public * License or the Artistic License, as specified in the README file. @@ -72,19 +72,19 @@ but only by their index allocated at compile time (which is usually 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. +xlow+1..xhigh inclusive in the NV union 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 also SVt_PVMG, with the +SvOURSTASH slot pointing at the stash of the associated global (so that +duplicate C declarations in the same package can be detected). SvUVX 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, -the name SV does not use NVX and IVX to store a cop_seq range, since it is -in scope throughout. Instead IVX stores some flags containing info about +the name SV does not use xlow and xhigh to store a cop_seq range, since it is +in scope throughout. Instead xhigh stores some flags containing info about the real lexical (is it declared in an anon, and is it capable of being -instantiated multiple times?), and for fake ANONs, NVX contains the index +instantiated multiple times?), and for fake ANONs, xlow contains the index within the parent's pad where the lexical's value is stored, to make cloning quicker. @@ -109,11 +109,26 @@ to be generated in evals, such as #include "EXTERN.h" #define PERL_IN_PAD_C #include "perl.h" +#include "keywords.h" +#define COP_SEQ_RANGE_LOW_set(sv,val) \ + STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END +#define COP_SEQ_RANGE_HIGH_set(sv,val) \ + STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END -#define PAD_MAX 999999999 +#define PARENT_PAD_INDEX_set(sv,val) \ + STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xlow = (val); } STMT_END +#define PARENT_FAKELEX_FLAGS_set(sv,val) \ + STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END +#define PAD_MAX I32_MAX +#ifdef PERL_MAD +void pad_peg(const char* s) { + static int pegcnt; + pegcnt++; +} +#endif /* =for apidoc pad_new @@ -153,7 +168,7 @@ Perl_pad_new(pTHX_ int flags) SAVEI32(PL_comppad_name_fill); SAVEI32(PL_min_intro_pending); SAVEI32(PL_max_intro_pending); - SAVEI32(PL_cv_has_eval); + SAVEBOOL(PL_cv_has_eval); if (flags & padnew_SAVESUB) { SAVEI32(PL_pad_reset_pending); } @@ -233,14 +248,15 @@ 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 */ return; DEBUG_X(PerlIO_printf(Perl_debug_log, - "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf"\n", - PTR2UV(cv), PTR2UV(padlist)) + "Pad undef: cv=0x%"UVxf" padlist=0x%"UVxf" comppad=0x%"UVxf"\n", + PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad)) ); /* detach any '&' anon children in the pad; if afterwards they @@ -272,37 +288,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 +335,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 +SvOURSTASH to that value If fake, it means we're cloning an existing entry @@ -329,26 +343,29 @@ 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); - SV* const namesv = newSV(0); + SV* const namesv + = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV); ASSERT_CURPAD_ACTIVE("pad_add_name"); - - sv_upgrade(namesv, ourstash ? SVt_PVGV : typestash ? SVt_PVMG : SVt_PVNV); sv_setpv(namesv, name); if (typestash) { - SvFLAGS(namesv) |= SVpad_TYPED; - SvSTASH_set(namesv, (HV*)SvREFCNT_inc((SV*) typestash)); + assert(SvTYPE(namesv) == SVt_PVMG); + SvPAD_TYPED_on(namesv); + SvSTASH_set(namesv, (HV*)SvREFCNT_inc_simple_NN((SV*)typestash)); } if (ourstash) { - SvFLAGS(namesv) |= SVpad_OUR; - GvSTASH(namesv) = ourstash; - Perl_sv_add_backref(aTHX_ (SV*)ourstash, namesv); + SvPAD_OUR_on(namesv); + SvOURSTASH_set(namesv, ourstash); + SvREFCNT_inc_simple_void_NN(ourstash); + } + else if (state) { + SvPAD_STATE_on(namesv); } av_store(PL_comppad_name, offset, namesv); @@ -359,8 +376,8 @@ Perl_pad_add_name(pTHX_ const char *name, HV* typestash, HV* ourstash, bool fake } else { /* not yet introduced */ - SvNV_set(namesv, (NV)PAD_MAX); /* min */ - SvIV_set(namesv, 0); /* max */ + COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */ + COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */ if (!PL_min_intro_pending) PL_min_intro_pending = offset; @@ -399,8 +416,6 @@ for a slot which has no name and no active value. /* And flag whether the incoming name is UTF8 or 8 bit? Could do this either with the +ve/-ve hack of the HV code, or expanding the flag bits. Either way, this makes proper Unicode safe pad support. - Also could change the sv structure to make the NV a union with 2 U32s, - so that SvCUR() could stop being overloaded in pad SVs. NWC */ @@ -469,11 +484,12 @@ Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type) { dVAR; PADOFFSET ix; - SV* const name = newSV(0); - sv_upgrade(name, SVt_PVNV); + SV* const name = newSV_type(SVt_PVNV); + pad_peg("add_anon"); sv_setpvn(name, "&", 1); - SvIV_set(name, -1); - SvNV_set(name, 1); + /* Are these two actually ever read? */ + COP_SEQ_RANGE_HIGH_set(name, ~0); + COP_SEQ_RANGE_LOW_set(name, 1); ix = pad_alloc(op_type, SVs_PADMY); av_store(PL_comppad_name, ix, name); /* XXX DAPM use PL_curpad[] ? */ @@ -527,16 +543,16 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) if (sv && sv != &PL_sv_undef && !SvFAKE(sv) - && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) + && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0) && strEQ(name, SvPVX_const(sv))) { - if (is_our && (SvFLAGS(sv) & SVpad_OUR)) + if (is_our && (SvPAD_OUR(sv))) 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_parser->in_my == KEY_my ? "my" : "state"), name, - (SvIVX(sv) == PAD_MAX ? "scope" : "statement")); + (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement")); --off; break; } @@ -548,8 +564,8 @@ Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash) if (sv && sv != &PL_sv_undef && !SvFAKE(sv) - && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0) - && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash) + && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0) + && SvOURSTASH(sv) == ourstash && strEQ(name, SvPVX_const(sv))) { Perl_warner(aTHX_ packWARN(WARN_MISC), @@ -586,9 +602,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 @@ -601,9 +618,9 @@ Perl_pad_findmy(pTHX_ const char *name) const SV * const namesv = name_svp[offset]; if (namesv && namesv != &PL_sv_undef && !SvFAKE(namesv) - && (SvFLAGS(namesv) & SVpad_OUR) + && (SvPAD_OUR(namesv)) && strEQ(SvPVX_const(namesv), name) - && U_32(SvNVX(namesv)) == PAD_MAX /* min */ + && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */ ) return offset; } @@ -642,17 +659,12 @@ associated with the IVX field of a fake namesv. Note that pad_findlex() is recursive; it recurses up the chain of CVs, then comes back down, adding fake entries as it goes. It has to be this way -because fake namesvs in anon protoypes have to store in NVX the index into +because fake namesvs in anon protoypes have to store in xlow the index into the parent pad. =cut */ -/* Flags set in the SvIVX field of FAKE namesvs */ - -#define PAD_FAKELEX_ANON 1 /* the lex is declared in an ANON, or ... */ -#define PAD_FAKELEX_MULTI 2 /* the lex can be instantiated multiple times */ - /* the CV has finished being compiled. This is not a sufficient test for * all CVs (eg XSUBs), but suffices for the CVs found in a lexical chain */ #define CvCOMPILED(cv) CvROOT(cv) @@ -691,8 +703,8 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, { if (SvFAKE(namesv)) fake_offset = offset; /* in case we don't find a real one */ - else if ( seq > U_32(SvNVX(namesv)) /* min */ - && seq <= (U32)SvIVX(namesv)) /* max */ + else if ( seq > COP_SEQ_RANGE_LOW(namesv) /* min */ + && seq <= COP_SEQ_RANGE_HIGH(namesv)) /* max */ break; } } @@ -715,18 +727,19 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, ? PAD_FAKELEX_MULTI : 0; DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%ld,%ld)\n", - PTR2UV(cv), (long)offset, (long)U_32(SvNVX(*out_name_sv)), - (long)SvIVX(*out_name_sv))); + "Pad findlex cv=0x%"UVxf" matched: offset=%ld (%lu,%lu)\n", + PTR2UV(cv), (long)offset, + (unsigned long)COP_SEQ_RANGE_LOW(*out_name_sv), + (unsigned long)COP_SEQ_RANGE_HIGH(*out_name_sv))); } else { /* fake match */ offset = fake_offset; *out_name_sv = name_svp[offset]; /* return the namesv */ - *out_flags = SvIVX(*out_name_sv); + *out_flags = PARENT_FAKELEX_FLAGS(*out_name_sv); DEBUG_Xv(PerlIO_printf(Perl_debug_log, "Pad findlex cv=0x%"UVxf" matched: offset=%ld flags=0x%lx index=%lu\n", PTR2UV(cv), (long)offset, (unsigned long)*out_flags, - (unsigned long)SvNVX(*out_name_sv) + (unsigned long) PARENT_PAD_INDEX(*out_name_sv) )); } @@ -735,7 +748,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, if (out_capture) { /* our ? */ - if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) { + if (SvPAD_OUR(*out_name_sv)) { *out_capture = NULL; return offset; } @@ -808,7 +821,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 +829,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 @@ -836,23 +849,23 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, new_offset = pad_add_name( SvPVX_const(*out_name_sv), - (SvFLAGS(*out_name_sv) & SVpad_TYPED) + SvPAD_TYPED(*out_name_sv) ? SvSTASH(*out_name_sv) : NULL, - (SvFLAGS(*out_name_sv) & SVpad_OUR) - ? GvSTASH(*out_name_sv) : NULL, - 1 /* fake */ + SvOURSTASH(*out_name_sv), + 1, /* fake */ + 0 /* not a state variable */ ); new_namesv = AvARRAY(PL_comppad_name)[new_offset]; - SvIV_set(new_namesv, *out_flags); + PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags); - SvNV_set(new_namesv, (NV)0); - if (SvFLAGS(new_namesv) & SVpad_OUR) { - /*EMPTY*/; /* do nothing */ + PARENT_PAD_INDEX_set(new_namesv, 0); + if (SvPAD_OUR(new_namesv)) { + NOOP; /* do nothing */ } else if (CvLATE(cv)) { /* delayed creation - just note the offset within parent pad */ - SvNV_set(new_namesv, (NV)offset); + PARENT_PAD_INDEX_set(new_namesv, offset); CvCLONE_on(cv); } else { @@ -863,7 +876,7 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn, PTR2UV(cv), PTR2UV(*new_capturep), (long)new_offset)); } *out_name_sv = new_namesv; - *out_flags = SvIVX(new_namesv); + *out_flags = PARENT_FAKELEX_FLAGS(new_namesv); PL_comppad_name = ocomppad_name; PL_comppad = ocomppad; @@ -983,13 +996,14 @@ Perl_intro_my(pTHX) for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) { SV * const sv = svp[i]; - if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !SvIVX(sv)) { - SvIV_set(sv, PAD_MAX); /* Don't know scope end yet. */ - SvNV_set(sv, (NV)PL_cop_seqmax); + if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && !COP_SEQ_RANGE_HIGH(sv)) { + COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX); /* Don't know scope end yet. */ + COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax); DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad intromy: %ld \"%s\", (%ld,%ld)\n", + "Pad intromy: %ld \"%s\", (%lu,%lu)\n", (long)i, SvPVX_const(sv), - (long)U_32(SvNVX(sv)), (long)SvIVX(sv)) + (unsigned long)COP_SEQ_RANGE_LOW(sv), + (unsigned long)COP_SEQ_RANGE_HIGH(sv)) ); } } @@ -1026,18 +1040,20 @@ 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", + SVfARG(sv)); } } /* "Deintroduce" my variables that are leaving with this scope. */ for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) { const SV * const sv = svp[off]; - if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX) { - SvIV_set(sv, PL_cop_seqmax); + if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PAD_MAX) { + COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax); DEBUG_Xv(PerlIO_printf(Perl_debug_log, - "Pad leavemy: %ld \"%s\", (%ld,%ld)\n", + "Pad leavemy: %ld \"%s\", (%lu,%lu)\n", (long)off, SvPVX_const(sv), - (long)U_32(SvNVX(sv)), (long)SvIVX(sv)) + (unsigned long)COP_SEQ_RANGE_LOW(sv), + (unsigned long)COP_SEQ_RANGE_HIGH(sv)) ); } } @@ -1324,18 +1340,18 @@ Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full) PTR2UV(ppad[ix]), (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0), SvPVX_const(namesv), - (unsigned long)SvIVX(namesv), - (unsigned long)SvNVX(namesv) + (unsigned long)PARENT_FAKELEX_FLAGS(namesv), + (unsigned long)PARENT_PAD_INDEX(namesv) ); else Perl_dump_indent(aTHX_ level+1, file, - "%2d. 0x%"UVxf"<%lu> (%ld,%ld) \"%s\"\n", + "%2d. 0x%"UVxf"<%lu> (%lu,%lu) \"%s\"\n", (int) ix, PTR2UV(ppad[ix]), (unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0), - (long)U_32(SvNVX(namesv)), - (long)SvIVX(namesv), + (unsigned long)COP_SEQ_RANGE_LOW(namesv), + (unsigned long)COP_SEQ_RANGE_HIGH(namesv), SvPVX_const(namesv) ); } @@ -1439,14 +1455,13 @@ Perl_cv_clone(pTHX_ CV *proto) ENTER; SAVESPTR(PL_compcv); - cv = PL_compcv = (CV*)newSV(0); - sv_upgrade((SV *)cv, SvTYPE(proto)); + cv = PL_compcv = (CV*)newSV_type(SvTYPE(proto)); CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE); CvCLONED_on(cv); #ifdef USE_ITHREADS - CvFILE(cv) = CvXSUB(proto) ? CvFILE(proto) - : savepv(CvFILE(proto)); + CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto) + : savepv(CvFILE(proto)); #else CvFILE(cv) = CvFILE(proto); #endif @@ -1456,7 +1471,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)) @@ -1477,7 +1492,7 @@ Perl_cv_clone(pTHX_ CV *proto) SV *sv = NULL; if (namesv && namesv != &PL_sv_undef) { /* lexical */ if (SvFAKE(namesv)) { /* lexical from outside? */ - sv = outpad[(I32)SvNVX(namesv)]; + sv = outpad[PARENT_PAD_INDEX(namesv)]; assert(sv); /* formats may have an inactive parent */ if (SvTYPE(proto) == SVt_PVFM && SvPADSTALE(sv)) { @@ -1486,9 +1501,9 @@ Perl_cv_clone(pTHX_ CV *proto) "Variable \"%s\" is not available", SvPVX_const(namesv)); sv = NULL; } - else { - assert(!SvPADSTALE(sv)); - sv = SvREFCNT_inc(sv); + /* 'my $x if $y' can leave $x stale even in an active sub */ + else if (!SvPADSTALE(sv)) { + SvREFCNT_inc_simple_void_NN(sv); } } if (!sv) { @@ -1505,7 +1520,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 +1607,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]); @@ -1607,7 +1619,10 @@ 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_const(names[ix])[0]; - if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') { + if ((SvFLAGS(names[ix]) & SVf_FAKE) + || (SvFLAGS(names[ix]) & SVpad_STATE) + || sigil == '&') + { /* outer lexical or anon code */ av_store(newpad, ix, SvREFCNT_inc(oldpad[ix])); } @@ -1624,7 +1639,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? */ @@ -1649,7 +1664,7 @@ Perl_pad_compname_type(pTHX_ const PADOFFSET po) { dVAR; SV* const * const av = av_fetch(PL_comppad_name, po, FALSE); - if ( SvFLAGS(*av) & SVpad_TYPED ) { + if ( SvPAD_TYPED(*av) ) { return SvSTASH(*av); } return NULL;