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<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
-stash of the associated global (so that duplicate C<our> declarations in the
-same package can be detected). SvCUR is sometimes hijacked to
-store the generation number during compilation.
+type. For C<our> lexicals, the type is also SVt_PVMG, with the OURSTASH slot
+pointing at the stash of the associated global (so that duplicate C<our>
+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,
#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
I32 ix;
const PADLIST * const padlist = CvPADLIST(cv);
+ pad_peg("pad_undef");
if (!padlist)
return;
if (SvIS_FREED(padlist)) /* may be during global destruction */
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);
}
If C<typestash> is valid, the name is for a typed lexical; set the
name's stash to that value.
If C<ourstash> 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
*/
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);
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) {
- 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);
+ OURSTASH_set(namesv, ourstash);
+ SvREFCNT_inc_simple_void_NN(ourstash);
+ }
+ else if (state) {
+ SvPAD_STATE_on(namesv);
}
av_store(PL_comppad_name, offset, namesv);
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);
&& (SvIVX(sv) == PAD_MAX || SvIVX(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_in_my == KEY_my ? "my" : "state"),
name,
(SvIVX(sv) == PAD_MAX ? "scope" : "statement"));
--off;
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
&& (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
- && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
+ && OURSTASH(sv) == ourstash
&& strEQ(name, SvPVX_const(sv)))
{
Perl_warner(aTHX_ packWARN(WARN_MISC),
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
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 */
)
if (out_capture) {
/* our ? */
- if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
+ if (SvPAD_OUR(*out_name_sv)) {
*out_capture = NULL;
return offset;
}
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 :
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
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 */
+ OURSTASH(*out_name_sv),
+ 1, /* fake */
+ 0 /* not a state variable */
);
new_namesv = AvARRAY(PL_comppad_name)[new_offset];
SvIV_set(new_namesv, *out_flags);
SvNV_set(new_namesv, (NV)0);
- if (SvFLAGS(new_namesv) & SVpad_OUR) {
- /*EMPTY*/; /* do nothing */
+ if (SvPAD_OUR(new_namesv)) {
+ NOOP; /* do nothing */
}
else if (CvLATE(cv)) {
/* delayed creation - just note the offset within parent pad */
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. */
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))
}
else {
assert(!SvPADSTALE(sv));
- sv = SvREFCNT_inc(sv);
+ SvREFCNT_inc_simple_void_NN(sv);
}
}
if (!sv) {
}
}
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);
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]);
}
}
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? */
{
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;