/* pad.c
*
- * Copyright (C) 2002, 2003, 2004, 2005 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.
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<our> lexicals, the type is SVt_PVGV, and GvSTASH points at the
-stash of the associated global (so that duplicate C<our> delarations 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<our> lexicals, the type is also SVt_PVMG, with the
+SvOURSTASH slot pointing at the stash of the associated global (so that
+duplicate C<our> 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.
{ my $x = 1; sub f { eval '$x'} } f();
+For state vars, SVf_PADSTALE is overloaded to mean 'not yet initialised'
+
=cut
*/
#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
PADLIST *
Perl_pad_new(pTHX_ int flags)
{
+ dVAR;
AV *padlist, *padname, *pad;
ASSERT_CURPAD_LEGAL("pad_new");
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);
}
AV * const a0 = newAV(); /* will be @_ */
av_extend(a0, 0);
av_store(pad, 0, (SV*)a0);
- AvFLAGS(a0) = AVf_REIFY;
+ AvREIFY_only(a0);
}
else {
- av_store(pad, 0, Nullsv);
+ av_store(pad, 0, NULL);
}
AvREAL_off(padlist);
void
Perl_pad_undef(pTHX_ CV* cv)
{
+ dVAR;
I32 ix;
- const PADLIST *padlist = CvPADLIST(cv);
+ const PADLIST * const padlist = CvPADLIST(cv);
+ pad_peg("pad_undef");
if (!padlist)
return;
- if (!SvREFCNT(CvPADLIST(cv))) /* may be during global destruction */
+ 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
* children, or integrate this loop with general cleanup */
if (!PL_dirty) { /* don't bother during global destruction */
- CV *outercv = CvOUTSIDE(cv);
+ CV * const outercv = CvOUTSIDE(cv);
const U32 seq = CvOUTSIDE_SEQ(cv);
- AV *comppad_name = (AV*)AvARRAY(padlist)[0];
- SV **namepad = AvARRAY(comppad_name);
- AV *comppad = (AV*)AvARRAY(padlist)[1];
- SV **curpad = AvARRAY(comppad);
+ AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
+ SV ** const namepad = AvARRAY(comppad_name);
+ AV * const comppad = (AV*)AvARRAY(padlist)[1];
+ SV ** const curpad = AvARRAY(comppad);
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
- SV *namesv = namepad[ix];
+ SV * const namesv = namepad[ix];
if (namesv && namesv != &PL_sv_undef
- && *SvPVX(namesv) == '&')
+ && *SvPVX_const(namesv) == '&')
{
CV * const innercv = (CV*)curpad[ix];
- namepad[ix] = Nullsv;
+ U32 inner_rc = SvREFCNT(innercv);
+ assert(inner_rc);
+ namepad[ix] = NULL;
SvREFCNT_dec(namesv);
if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
- curpad[ix] = Nullsv;
+ curpad[ix] = NULL;
SvREFCNT_dec(innercv);
+ inner_rc--;
}
- if (SvREFCNT(innercv) /* 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) = Nullcv;
+ CvOUTSIDE(innercv) = NULL;
}
-
}
-
}
}
}
ix = AvFILLp(padlist);
while (ix >= 0) {
- SV* sv = AvARRAY(padlist)[ix--];
- if (!sv)
- continue;
- if (sv == (SV*)PL_comppad_name)
- PL_comppad_name = Nullav;
- 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);
}
SvREFCNT_dec((SV*)CvPADLIST(cv));
- CvPADLIST(cv) = Null(PADLIST*);
+ CvPADLIST(cv) = NULL;
}
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
+SvOURSTASH 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)
{
- PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
- SV* namesv = NEWSV(1102, 0);
+ dVAR;
+ const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+ 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(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) = (HV*)SvREFCNT_inc((SV*) ourstash);
+ 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);
}
else {
/* not yet introduced */
- SvNV_set(namesv, (NV)PAD_MAX); /* min */
- SvIVX(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;
Allocate a new my or tmp pad entry. For a my, simply push a null SV onto
the end of PL_comppad, but for a tmp, scan the pad from PL_padix upwards
-for a slot which has no name and and no active value.
+for a slot which has no name and no active value.
=cut
*/
/* XXX DAPM integrate alloc(), add_name() and add_anon(),
* or at least rationalise ??? */
-
+/* 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.
+ NWC
+*/
PADOFFSET
Perl_pad_alloc(pTHX_ I32 optype, U32 tmptype)
{
+ dVAR;
SV *sv;
I32 retval;
+ PERL_UNUSED_ARG(optype);
ASSERT_CURPAD_ACTIVE("pad_alloc");
if (AvARRAY(PL_comppad) != PL_curpad)
retval = AvFILLp(PL_comppad);
}
else {
- SV **names = AvARRAY(PL_comppad_name);
+ SV * const * const names = AvARRAY(PL_comppad_name);
const SSize_t names_fill = AvFILLp(PL_comppad_name);
for (;;) {
/*
PADOFFSET
Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
{
+ dVAR;
PADOFFSET ix;
- SV* name;
-
- name = NEWSV(1106, 0);
- sv_upgrade(name, SVt_PVNV);
+ SV* const name = newSV_type(SVt_PVNV);
+ pad_peg("add_anon");
sv_setpvn(name, "&", 1);
- SvIVX(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[] ? */
void
Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
{
- SV **svp, *sv;
+ dVAR;
+ SV **svp;
PADOFFSET top, off;
ASSERT_CURPAD_ACTIVE("pad_check_dup");
- if (!ckWARN(WARN_MISC) || AvFILLp(PL_comppad_name) < 0)
+ if (AvFILLp(PL_comppad_name) < 0 || !ckWARN(WARN_MISC))
return; /* nothing to check */
svp = AvARRAY(PL_comppad_name);
/* XXX DAPM - why the (I32) cast - shouldn't we ensure they're the same
* type ? */
for (off = top; (I32)off > PL_comppad_name_floor; off--) {
- if ((sv = svp[off])
+ SV * const sv = svp[off];
+ if (sv
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
- && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
- && (!is_our
- || ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash))
- && strEQ(name, SvPVX(sv)))
+ && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
+ && strEQ(name, SvPVX_const(sv)))
{
+ 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;
}
/* check the rest of the pad */
if (is_our) {
do {
- if ((sv = svp[off])
+ SV * const sv = svp[off];
+ if (sv
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
- && (SvIVX(sv) == PAD_MAX || SvIVX(sv) == 0)
- && ((SvFLAGS(sv) & SVpad_OUR) && GvSTASH(sv) == ourstash)
- && strEQ(name, SvPVX(sv)))
+ && (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),
"\"our\" variable %s redeclared", name);
- Perl_warner(aTHX_ packWARN(WARN_MISC),
- "\t(Did you mean \"local\" instead of \"our\"?)\n");
+ if ((I32)off <= PL_comppad_name_floor)
+ Perl_warner(aTHX_ packWARN(WARN_MISC),
+ "\t(Did you mean \"local\" instead of \"our\"?)\n");
break;
}
} while ( off-- > 0 );
PADOFFSET
Perl_pad_findmy(pTHX_ const char *name)
{
+ dVAR;
SV *out_sv;
int out_flags;
I32 offset;
const AV *nameav;
SV **name_svp;
- offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
- Null(SV**), &out_sv, &out_flags);
- if (offset != NOT_IN_PAD)
+ pad_peg("pad_findmy");
+ offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
+ NULL, &out_sv, &out_flags);
+ if ((PADOFFSET)offset != NOT_IN_PAD)
return offset;
/* look for an our that's being introduced; this allows
nameav = (AV*)AvARRAY(CvPADLIST(PL_compcv))[0];
name_svp = AvARRAY(nameav);
for (offset = AvFILLp(nameav); offset > 0; offset--) {
- const SV *namesv = name_svp[offset];
+ const SV * const namesv = name_svp[offset];
if (namesv && namesv != &PL_sv_undef
&& !SvFAKE(namesv)
- && (SvFLAGS(namesv) & SVpad_OUR)
- && strEQ(SvPVX(namesv), name)
- && U_32(SvNVX(namesv)) == PAD_MAX /* min */
+ && (SvPAD_OUR(namesv))
+ && strEQ(SvPVX_const(namesv), name)
+ && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */
)
return offset;
}
PADOFFSET
Perl_find_rundefsvoffset(pTHX)
{
+ dVAR;
SV *out_sv;
int out_flags;
return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
- Null(SV**), &out_sv, &out_flags);
+ NULL, &out_sv, &out_flags);
}
/*
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)
S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
SV** out_capture, SV** out_name_sv, int *out_flags)
{
+ dVAR;
I32 offset, new_offset;
SV *new_capture;
SV **new_capturep;
- const AV *padlist = CvPADLIST(cv);
+ const AV * const padlist = CvPADLIST(cv);
*out_flags = 0;
if (padlist) { /* not an undef CV */
I32 fake_offset = 0;
- const AV *nameav = (AV*)AvARRAY(padlist)[0];
- SV **name_svp = AvARRAY(nameav);
+ const AV * const nameav = (AV*)AvARRAY(padlist)[0];
+ SV * const * const name_svp = AvARRAY(nameav);
for (offset = AvFILLp(nameav); offset > 0; offset--) {
- const SV *namesv = name_svp[offset];
+ const SV * const namesv = name_svp[offset];
if (namesv && namesv != &PL_sv_undef
- && strEQ(SvPVX(namesv), name))
+ && strEQ(SvPVX_const(namesv), name))
{
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;
}
}
? 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)
));
}
if (out_capture) {
/* our ? */
- if ((SvFLAGS(*out_name_sv) & SVpad_OUR)) {
- *out_capture = Nullsv;
+ if (SvPAD_OUR(*out_name_sv)) {
+ *out_capture = NULL;
return offset;
}
if (warn && ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Variable \"%s\" is not available", name);
- *out_capture = Nullsv;
+ *out_capture = NULL;
}
/* real value */
else {
int newwarn = warn;
if (!CvCOMPILED(cv) && (*out_flags & PAD_FAKELEX_MULTI)
+ && !SvPAD_STATE(name_svp[offset])
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
PTR2UV(cv)));
n = *out_name_sv;
- pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv),
+ (void) pad_findlex(name, CvOUTSIDE(cv),
+ CvOUTSIDE_SEQ(cv),
newwarn, out_capture, out_name_sv, out_flags);
*out_name_sv = n;
return offset;
"Pad findlex cv=0x%"UVxf" found lex=0x%"UVxf"\n",
PTR2UV(cv), PTR2UV(*out_capture)));
- if (SvPADSTALE(*out_capture)) {
+ if (SvPADSTALE(*out_capture)
+ && !SvPAD_STATE(name_svp[offset]))
+ {
if (ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
"Variable \"%s\" is not available", name);
- *out_capture = Nullsv;
+ *out_capture = NULL;
}
}
if (!*out_capture) {
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 :
- CvLATE(cv) ? Null(SV**) : &new_capture;
+ CvLATE(cv) ? NULL : &new_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
{
SV *new_namesv;
- AV *ocomppad_name = PL_comppad_name;
- PAD *ocomppad = PL_comppad;
+ AV * const ocomppad_name = PL_comppad_name;
+ PAD * const ocomppad = PL_comppad;
PL_comppad_name = (AV*)AvARRAY(padlist)[0];
PL_comppad = (AV*)AvARRAY(padlist)[1];
PL_curpad = AvARRAY(PL_comppad);
new_offset = pad_add_name(
- SvPVX(*out_name_sv),
- (SvFLAGS(*out_name_sv) & SVpad_TYPED)
- ? SvSTASH(*out_name_sv) : Nullhv,
- (SvFLAGS(*out_name_sv) & SVpad_OUR)
- ? GvSTASH(*out_name_sv) : Nullhv,
- 1 /* fake */
+ SvPVX_const(*out_name_sv),
+ SvPAD_TYPED(*out_name_sv)
+ ? SvSTASH(*out_name_sv) : NULL,
+ SvOURSTASH(*out_name_sv),
+ 1, /* fake */
+ SvPAD_STATE(*out_name_sv) ? 1 : 0 /* state variable ? */
);
new_namesv = AvARRAY(PL_comppad_name)[new_offset];
- SvIVX(new_namesv) = *out_flags;
+ PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
- SvNV_set(new_namesv, (NV)0);
- if (SvFLAGS(new_namesv) & SVpad_OUR) {
- /* 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 {
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;
- PL_curpad = ocomppad ? AvARRAY(ocomppad) : Null(SV **);
+ PL_curpad = ocomppad ? AvARRAY(ocomppad) : NULL;
}
return new_offset;
}
-
+
+#ifdef DEBUGGING
/*
=for apidoc pad_sv
SV *
Perl_pad_sv(pTHX_ PADOFFSET po)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_sv");
if (!po)
=cut
*/
-#ifdef DEBUGGING
void
Perl_pad_setsv(pTHX_ PADOFFSET po, SV* sv)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_setsv");
DEBUG_X(PerlIO_printf(Perl_debug_log,
void
Perl_pad_block_start(pTHX_ int full)
{
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_block_start");
SAVEI32(PL_comppad_name_floor);
PL_comppad_name_floor = AvFILLp(PL_comppad_name);
U32
Perl_intro_my(pTHX)
{
+ dVAR;
SV **svp;
- SV *sv;
I32 i;
ASSERT_CURPAD_ACTIVE("intro_my");
svp = AvARRAY(PL_comppad_name);
for (i = PL_min_intro_pending; i <= PL_max_intro_pending; i++) {
- if ((sv = svp[i]) && sv != &PL_sv_undef
- && !SvFAKE(sv) && !SvIVX(sv))
- {
- SvIVX(sv) = PAD_MAX; /* Don't know scope end yet. */
- SvNV_set(sv, (NV)PL_cop_seqmax);
+ SV * const sv = svp[i];
+
+ 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",
- (long)i, SvPVX(sv),
- (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
+ "Pad intromy: %ld \"%s\", (%lu,%lu)\n",
+ (long)i, SvPVX_const(sv),
+ (unsigned long)COP_SEQ_RANGE_LOW(sv),
+ (unsigned long)COP_SEQ_RANGE_HIGH(sv))
);
}
}
void
Perl_pad_leavemy(pTHX)
{
+ dVAR;
I32 off;
- SV **svp = AvARRAY(PL_comppad_name);
+ SV * const * const svp = AvARRAY(PL_comppad_name);
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--) {
- const SV *sv;
- if ((sv = svp[off]) && sv != &PL_sv_undef
+ const SV * const sv = svp[off];
+ 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 *sv;
- if ((sv = svp[off]) && sv != &PL_sv_undef
- && !SvFAKE(sv) && SvIVX(sv) == PAD_MAX)
- {
- SvIVX(sv) = PL_cop_seqmax;
+ const SV * const sv = svp[off];
+ 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",
- (long)off, SvPVX(sv),
- (long)U_32(SvNVX(sv)), (long)SvIVX(sv))
+ "Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
+ (long)off, SvPVX_const(sv),
+ (unsigned long)COP_SEQ_RANGE_LOW(sv),
+ (unsigned long)COP_SEQ_RANGE_HIGH(sv))
);
}
}
void
Perl_pad_swipe(pTHX_ PADOFFSET po, bool refadjust)
{
+ dVAR;
ASSERT_CURPAD_LEGAL("pad_swipe");
if (!PL_curpad)
return;
if (refadjust)
SvREFCNT_dec(PL_curpad[po]);
- PL_curpad[po] = NEWSV(1107,0);
+
+ /* if pad tmps aren't shared between ops, then there's no need to
+ * create a new tmp when an existing op is freed */
+#ifdef USE_BROKEN_PAD_RESET
+ PL_curpad[po] = newSV(0);
SvPADTMP_on(PL_curpad[po]);
+#else
+ PL_curpad[po] = &PL_sv_undef;
+#endif
if ((I32)po < PL_padix)
PL_padix = po - 1;
}
void
Perl_pad_reset(pTHX)
{
+ dVAR;
#ifdef USE_BROKEN_PAD_RESET
if (AvARRAY(PL_comppad) != PL_curpad)
Perl_croak(aTHX_ "panic: pad_reset curpad");
void
Perl_pad_tidy(pTHX_ padtidy_type type)
{
- PADOFFSET ix;
+ dVAR;
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);
+ av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
if (type == padtidy_SUBCLONE) {
- SV **namep = AvARRAY(PL_comppad_name);
+ SV * const * const namep = AvARRAY(PL_comppad_name);
+ PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
* pad are anonymous subs.
* The rest are created anew during cloning.
*/
- if (!((namesv = namep[ix]) != Nullsv &&
+ if (!((namesv = namep[ix]) != NULL &&
namesv != &PL_sv_undef &&
- *SvPVX(namesv) == '&'))
+ *SvPVX_const(namesv) == '&'))
{
SvREFCNT_dec(PL_curpad[ix]);
- PL_curpad[ix] = Nullsv;
+ PL_curpad[ix] = NULL;
}
}
}
else if (type == padtidy_SUB) {
/* XXX DAPM this same bit of code keeps appearing !!! Rationalise? */
- AV *av = newAV(); /* Will be @_ */
+ AV * const av = newAV(); /* Will be @_ */
av_extend(av, 0);
av_store(PL_comppad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
+ AvREIFY_only(av);
}
/* XXX DAPM rationalise these two similar branches */
if (type == padtidy_SUB) {
+ PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
continue;
}
}
else if (type == padtidy_FORMAT) {
+ PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
if (!SvPADMY(PL_curpad[ix]) && !SvIMMORTAL(PL_curpad[ix]))
SvPADTMP_on(PL_curpad[ix]);
/*
=for apidoc pad_free
-Free the SV at offet po in the current pad.
+Free the SV at offset po in the current pad.
=cut
*/
void
Perl_pad_free(pTHX_ PADOFFSET po)
{
+ dVAR;
ASSERT_CURPAD_LEGAL("pad_free");
if (!PL_curpad)
return;
#ifdef USE_ITHREADS
/* SV could be a shared hash key (eg bugid #19022) */
if (
-#ifdef PERL_COPY_ON_WRITE
+#ifdef PERL_OLD_COPY_ON_WRITE
!SvIsCOW(PL_curpad[po])
#else
!SvFAKE(PL_curpad[po])
void
Perl_do_dump_pad(pTHX_ I32 level, PerlIO *file, PADLIST *padlist, int full)
{
+ dVAR;
const AV *pad_name;
const AV *pad;
SV **pname;
for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
const SV *namesv = pname[ix];
if (namesv && namesv == &PL_sv_undef) {
- namesv = Nullsv;
+ namesv = NULL;
}
if (namesv) {
if (SvFAKE(namesv))
(int) ix,
PTR2UV(ppad[ix]),
(unsigned long) (ppad[ix] ? SvREFCNT(ppad[ix]) : 0),
- SvPVX(namesv),
- (unsigned long)SvIVX(namesv),
- (unsigned long)SvNVX(namesv)
+ SvPVX_const(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),
- SvPVX(namesv)
+ (unsigned long)COP_SEQ_RANGE_LOW(namesv),
+ (unsigned long)COP_SEQ_RANGE_HIGH(namesv),
+ SvPVX_const(namesv)
);
}
else if (full) {
STATIC void
S_cv_dump(pTHX_ const CV *cv, const char *title)
{
- const CV *outside = CvOUTSIDE(cv);
- AV* padlist = CvPADLIST(cv);
+ dVAR;
+ const CV * const outside = CvOUTSIDE(cv);
+ AV* const padlist = CvPADLIST(cv);
PerlIO_printf(Perl_debug_log,
" %s: CV=0x%"UVxf" (%s), OUTSIDE=0x%"UVxf" (%s)\n",
CV *
Perl_cv_clone(pTHX_ CV *proto)
{
+ dVAR;
I32 ix;
- AV* protopadlist = CvPADLIST(proto);
- const AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
- const AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
- SV** pname = AvARRAY(protopad_name);
- SV** ppad = AvARRAY(protopad);
+ AV* const protopadlist = CvPADLIST(proto);
+ const AV* const protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
+ const AV* const protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
+ SV** const pname = AvARRAY(protopad_name);
+ SV** const ppad = AvARRAY(protopad);
const I32 fname = AvFILLp(protopad_name);
const I32 fpad = AvFILLp(protopad);
- AV* comppadlist;
CV* cv;
SV** outpad;
CV* outside;
ENTER;
SAVESPTR(PL_compcv);
- cv = PL_compcv = (CV*)NEWSV(1104, 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
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))
- sv_setpvn((SV*)cv, SvPVX(proto), SvCUR(proto));
+ sv_setpvn((SV*)cv, SvPVX_const(proto), SvCUR(proto));
- CvPADLIST(cv) = comppadlist = pad_new(padnew_CLONE|padnew_SAVE);
+ CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
av_fill(PL_comppad, fpad);
for (ix = fname; ix >= 0; ix--)
outpad = AvARRAY(AvARRAY(CvPADLIST(outside))[depth]);
for (ix = fpad; ix > 0; ix--) {
- SV* namesv = (ix <= fname) ? pname[ix] : Nullsv;
- SV *sv = Nullsv;
+ SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
+ 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)) {
+ /* formats may have an inactive parent,
+ while my $x if $false can leave an active var marked as
+ stale. And state vars are always available */
+ if (SvPADSTALE(sv) && !SvPAD_STATE(namesv)) {
if (ckWARN(WARN_CLOSURE))
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", SvPVX(namesv));
- sv = Nullsv;
- }
- else {
- assert(!SvPADSTALE(sv));
- sv = SvREFCNT_inc(sv);
+ "Variable \"%s\" is not available", SvPVX_const(namesv));
+ sv = NULL;
}
+ else
+ SvREFCNT_inc_simple_void_NN(sv);
}
if (!sv) {
- const char sigil = SvPVX(namesv)[0];
+ const char sigil = SvPVX_const(namesv)[0];
if (sigil == '&')
sv = SvREFCNT_inc(ppad[ix]);
else if (sigil == '@')
else if (sigil == '%')
sv = (SV*)newHV();
else
- sv = NEWSV(0, 0);
+ sv = newSV(0);
SvPADMY_on(sv);
+ /* reset the 'assign only once' flag on each state var */
+ if (SvPAD_STATE(namesv))
+ SvPADSTALE_on(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, 0);
+ sv = newSV(0);
SvPADTMP_on(sv);
}
PL_curpad[ix] = sv;
* so try to grab the current const value, and if successful,
* turn into a const sub:
*/
- SV* const_sv = op_const_sv(CvSTART(cv), cv);
+ SV* const const_sv = op_const_sv(CvSTART(cv), cv);
if (const_sv) {
SvREFCNT_dec(cv);
- cv = newCONSTSUB(CvSTASH(proto), 0, const_sv);
+ cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
}
else {
CvCONST_off(cv);
void
Perl_pad_fixup_inner_anons(pTHX_ PADLIST *padlist, CV *old_cv, CV *new_cv)
{
+ dVAR;
I32 ix;
- AV *comppad_name = (AV*)AvARRAY(padlist)[0];
- AV *comppad = (AV*)AvARRAY(padlist)[1];
- SV **namepad = AvARRAY(comppad_name);
- SV **curpad = AvARRAY(comppad);
+ AV * const comppad_name = (AV*)AvARRAY(padlist)[0];
+ AV * const comppad = (AV*)AvARRAY(padlist)[1];
+ SV ** const namepad = AvARRAY(comppad_name);
+ SV ** const curpad = AvARRAY(comppad);
+ PERL_UNUSED_ARG(old_cv);
+
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
- const SV *namesv = namepad[ix];
+ const SV * const namesv = namepad[ix];
if (namesv && namesv != &PL_sv_undef
- && *SvPVX(namesv) == '&')
+ && *SvPVX_const(namesv) == '&')
{
- CV *innercv = (CV*)curpad[ix];
+ CV * const innercv = (CV*)curpad[ix];
assert(CvWEAKOUTSIDE(innercv));
assert(CvOUTSIDE(innercv) == old_cv);
CvOUTSIDE(innercv) = new_cv;
void
Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
{
- if (depth <= AvFILLp(padlist))
- return;
-
- {
- SV** svp = AvARRAY(padlist);
- AV *newpad = newAV();
- SV **oldpad = AvARRAY(svp[depth-1]);
+ dVAR;
+ if (depth > AvFILLp(padlist)) {
+ SV** const svp = AvARRAY(padlist);
+ AV* const newpad = newAV();
+ SV** const oldpad = AvARRAY(svp[depth-1]);
I32 ix = AvFILLp((AV*)svp[1]);
const I32 names_fill = AvFILLp((AV*)svp[0]);
- SV** names = AvARRAY(svp[0]);
+ SV** const names = AvARRAY(svp[0]);
AV *av;
for ( ;ix > 0; ix--) {
if (names_fill >= ix && names[ix] != &PL_sv_undef) {
- const char sigil = SvPVX(names[ix])[0];
- if ((SvFLAGS(names[ix]) & SVf_FAKE) || sigil == '&') {
+ const char sigil = SvPVX_const(names[ix])[0];
+ 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]));
}
else if (sigil == '%')
sv = (SV*)newHV();
else
- sv = NEWSV(0, 0);
+ sv = newSV(0);
av_store(newpad, ix, sv);
SvPADMY_on(sv);
}
}
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? */
- SV *sv = NEWSV(0, 0);
+ SV * const sv = newSV(0);
av_store(newpad, ix, sv);
SvPADTMP_on(sv);
}
av = newAV();
av_extend(av, 0);
av_store(newpad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
+ AvREIFY_only(av);
av_store(padlist, depth, (SV*)newpad);
AvFILLp(padlist) = depth;
}
}
+
+
+HV *
+Perl_pad_compname_type(pTHX_ const PADOFFSET po)
+{
+ dVAR;
+ SV* const * const av = av_fetch(PL_comppad_name, po, FALSE);
+ if ( SvPAD_TYPED(*av) ) {
+ return SvSTASH(*av);
+ }
+ return NULL;
+}
+
+/*
+ * Local variables:
+ * c-indentation-style: bsd
+ * c-basic-offset: 4
+ * indent-tabs-mode: t
+ * End:
+ *
+ * ex: set ts=8 sts=4 sw=4 noet:
+ */
https://perl5.git.perl.org / perl5.git / blobdiff