/* pad.c
*
- * Copyright (C) 2002,2003 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.
/*
=head1 Pad Data Structures
+This file contains the functions that create and manipulate scratchpads,
+which are array-of-array data structures attached to a CV (ie a sub)
+and which store lexical variables and opcode temporary and per-thread
+values.
+
=for apidoc m|AV *|CvPADLIST|CV *cv
CV's can have CvPADLIST(cv) set to point to an AV.
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.
Note that formats are treated as anon subs, and are cloned each time
write is called (if necessary).
+The flag SVf_PADSTALE is cleared on lexicals each time the my() is executed,
+and set on scope exit. This allows the 'Variable $x is not available' warning
+to be generated in evals, such as
+
+ { 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 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 999999999
+#define PAD_MAX I32_MAX
+#ifdef PERL_MAD
+void pad_peg(const char* s) {
+ static int pegcnt;
+ PERL_ARGS_ASSERT_PAD_PEG;
+
+ pegcnt++;
+}
+#endif
/*
=for apidoc pad_new
PADLIST *
Perl_pad_new(pTHX_ int flags)
{
- AV *padlist, *padname, *pad, *a0;
+ 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);
}
* dispensed with eventually ???
*/
- a0 = newAV(); /* will be @_ */
+ 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;
- PADLIST *padlist = CvPADLIST(cv);
+ const PADLIST * const padlist = CvPADLIST(cv);
+ PERL_ARGS_ASSERT_PAD_UNDEF;
+
+ 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);
- 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);
+ CV * const outercv = CvOUTSIDE(cv);
+ const U32 seq = CvOUTSIDE_SEQ(cv);
+ 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 *innercv = (CV*)curpad[ix];
- namepad[ix] = Nullsv;
+ CV * const innercv = (CV*)curpad[ix];
+ U32 inner_rc = SvREFCNT(innercv);
+ assert(inner_rc);
+ namepad[ix] = NULL;
SvREFCNT_dec(namesv);
- curpad[ix] = Nullsv;
- SvREFCNT_dec(innercv);
- if (SvREFCNT(innercv) /* in use, not just a prototype */
- && CvOUTSIDE(innercv) == cv)
- {
+
+ if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
+ curpad[ix] = NULL;
+ SvREFCNT_dec(innercv);
+ inner_rc--;
+ }
+
+ /* in use, not just a prototype */
+ if (inner_rc && (CvOUTSIDE(innercv) == cv)) {
assert(CvWEAKOUTSIDE(innercv));
- CvWEAKOUTSIDE_off(innercv);
- CvOUTSIDE_SEQ(innercv) = seq;
/* don't relink to grandfather if he's being freed */
- if (SvREFCNT(outercv)) {
+ if (outercv && SvREFCNT(outercv)) {
+ CvWEAKOUTSIDE_off(innercv);
CvOUTSIDE(innercv) = outercv;
- SvREFCNT_inc(outercv);
+ CvOUTSIDE_SEQ(innercv) = seq;
+ 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_ 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");
+ PERL_ARGS_ASSERT_PAD_ADD_NAME;
+ 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 */
- SvNVX(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);
- SSize_t names_fill = AvFILLp(PL_comppad_name);
+ SV * const * const names = AvARRAY(PL_comppad_name);
+ const SSize_t names_fill = AvFILLp(PL_comppad_name);
for (;;) {
/*
* "foreach" index vars temporarily become aliases to non-"my"
"Pad 0x%"UVxf"[0x%"UVxf"] alloc: %ld for %s\n",
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long) retval,
PL_op_name[optype]));
+#ifdef DEBUG_LEAKING_SCALARS
+ sv->sv_debug_optype = optype;
+ sv->sv_debug_inpad = 1;
+#endif
return (PADOFFSET)retval;
}
PADOFFSET
Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
{
+ dVAR;
PADOFFSET ix;
- SV* name;
+ SV* const name = newSV_type(SVt_PVNV);
- name = NEWSV(1106, 0);
- sv_upgrade(name, SVt_PVNV);
+ PERL_ARGS_ASSERT_PAD_ADD_ANON;
+
+ pad_peg("add_anon");
sv_setpvn(name, "&", 1);
- SvIVX(name) = -1;
- SvNVX(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[] ? */
/* XXX DAPM integrate this into pad_add_name ??? */
void
-Perl_pad_check_dup(pTHX_ char *name, bool is_our, HV *ourstash)
+Perl_pad_check_dup(pTHX_ const char *name, bool is_our, const HV *ourstash)
{
- SV **svp, *sv;
+ dVAR;
+ SV **svp;
PADOFFSET top, off;
+ PERL_ARGS_ASSERT_PAD_CHECK_DUP;
+
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_ char *name)
+Perl_pad_findmy(pTHX_ const char *name)
{
+ dVAR;
SV *out_sv;
int out_flags;
I32 offset;
- AV *nameav;
+ 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)
+ PERL_ARGS_ASSERT_PAD_FINDMY;
+
+ 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--) {
- 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;
}
return NOT_IN_PAD;
}
+/*
+ * Returns the offset of a lexical $_, if there is one, at run time.
+ * Used by the UNDERBAR XS macro.
+ */
+
+PADOFFSET
+Perl_find_rundefsvoffset(pTHX)
+{
+ dVAR;
+ SV *out_sv;
+ int out_flags;
+ return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+ NULL, &out_sv, &out_flags);
+}
/*
=for apidoc pad_findlex
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)
STATIC PADOFFSET
-S_pad_findlex(pTHX_ char *name, CV* cv, U32 seq, int warn,
+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;
- AV *padlist = CvPADLIST(cv);
+ const AV * const padlist = CvPADLIST(cv);
+
+ PERL_ARGS_ASSERT_PAD_FINDLEX;
*out_flags = 0;
if (padlist) { /* not an undef CV */
I32 fake_offset = 0;
- 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--) {
- 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);
- SvNVX(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 */
- SvNVX(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;
+
+ PERL_ARGS_ASSERT_PAD_SETSV;
+
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. */
- SvNVX(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 *sv;
+ 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--) {
- 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--) {
- 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
- register I32 po;
-
if (AvARRAY(PL_comppad) != PL_curpad)
Perl_croak(aTHX_ "panic: pad_reset curpad");
);
if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
+ register I32 po;
for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
SvPADTMP_off(PL_curpad[po]);
void
Perl_pad_tidy(pTHX_ padtidy_type type)
{
- PADOFFSET ix;
- CV *cv;
+ dVAR;
ASSERT_CURPAD_ACTIVE("pad_tidy");
*/
if (PL_cv_has_eval || PL_perldb) {
+ const CV *cv;
for (cv = PL_compcv ;cv; cv = CvOUTSIDE(cv)) {
if (cv != PL_compcv && CvCOMPILED(cv))
break; /* no need to mark already-compiled code */
/* 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)
{
- AV *pad_name;
- AV *pad;
+ dVAR;
+ const AV *pad_name;
+ const AV *pad;
SV **pname;
SV **ppad;
- SV *namesv;
I32 ix;
+ PERL_ARGS_ASSERT_DO_DUMP_PAD;
+
if (!padlist) {
return;
}
);
for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
- namesv = pname[ix];
+ const SV *namesv = pname[ix];
if (namesv && namesv == &PL_sv_undef) {
- namesv = Nullsv;
+ namesv = NULL;
}
if (namesv) {
if (SvFAKE(namesv))
Perl_dump_indent(aTHX_ level+1, file,
- "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%x index=%lu\n",
+ "%2d. 0x%"UVxf"<%lu> FAKE \"%s\" flags=0x%lx index=%lu\n",
(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) {
#ifdef DEBUGGING
STATIC void
-S_cv_dump(pTHX_ CV *cv, char *title)
+S_cv_dump(pTHX_ const CV *cv, const char *title)
{
- CV *outside = CvOUTSIDE(cv);
- AV* padlist = CvPADLIST(cv);
+ dVAR;
+ const CV * const outside = CvOUTSIDE(cv);
+ AV* const padlist = CvPADLIST(cv);
+
+ PERL_ARGS_ASSERT_CV_DUMP;
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);
- AV* protopad_name = (AV*)*av_fetch(protopadlist, 0, FALSE);
- AV* protopad = (AV*)*av_fetch(protopadlist, 1, FALSE);
- SV** pname = AvARRAY(protopad_name);
- SV** ppad = AvARRAY(protopad);
- I32 fname = AvFILLp(protopad_name);
- I32 fpad = AvFILLp(protopad);
- AV* comppadlist;
+ 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);
CV* cv;
SV** outpad;
CV* outside;
long depth;
+ PERL_ARGS_ASSERT_CV_CLONE;
+
assert(!CvUNIQUE(proto));
/* Since cloneable anon subs can be nested, CvOUTSIDE may point
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
CvGV(cv) = CvGV(proto);
CvSTASH(cv) = CvSTASH(proto);
+ OP_REFCNT_LOCK;
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) {
- char *name = SvPVX(namesv);
- if (*name == '&')
+ const char sigil = SvPVX_const(namesv)[0];
+ if (sigil == '&')
sv = SvREFCNT_inc(ppad[ix]);
- else if (*name == '@')
+ else if (sigil == '@')
sv = (SV*)newAV();
- else if (*name == '%')
+ 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_ARGS_ASSERT_PAD_FIXUP_INNER_ANONS;
+ PERL_UNUSED_ARG(old_cv);
+
for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
- 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;
=for apidoc pad_push
Push a new pad frame onto the padlist, unless there's already a pad at
-this depth, in which case don't bother creating a new one.
-If has_args is true, give the new pad an @_ in slot zero.
+this depth, in which case don't bother creating a new one. Then give
+the new pad an @_ in slot zero.
=cut
*/
void
-Perl_pad_push(pTHX_ PADLIST *padlist, int depth, int has_args)
+Perl_pad_push(pTHX_ PADLIST *padlist, int depth)
{
- if (depth <= AvFILLp(padlist))
- return;
+ dVAR;
- {
- SV** svp = AvARRAY(padlist);
- AV *newpad = newAV();
- SV **oldpad = AvARRAY(svp[depth-1]);
+ PERL_ARGS_ASSERT_PAD_PUSH;
+
+ 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]);
- I32 names_fill = AvFILLp((AV*)svp[0]);
- SV** names = AvARRAY(svp[0]);
- SV* sv;
+ const I32 names_fill = AvFILLp((AV*)svp[0]);
+ SV** const names = AvARRAY(svp[0]);
+ AV *av;
+
for ( ;ix > 0; ix--) {
if (names_fill >= ix && names[ix] != &PL_sv_undef) {
- char *name = SvPVX(names[ix]);
- if ((SvFLAGS(names[ix]) & SVf_FAKE) || *name == '&') {
+ 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 { /* our own lexical */
- if (*name == '@')
- av_store(newpad, ix, sv = (SV*)newAV());
- else if (*name == '%')
- av_store(newpad, ix, sv = (SV*)newHV());
+ SV *sv;
+ if (sigil == '@')
+ sv = (SV*)newAV();
+ else if (sigil == '%')
+ sv = (SV*)newHV();
else
- av_store(newpad, ix, 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, sv = SvREFCNT_inc(oldpad[ix]));
+ av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
}
else {
/* save temporaries on recursion? */
- av_store(newpad, ix, sv = NEWSV(0, 0));
+ SV * const sv = newSV(0);
+ av_store(newpad, ix, sv);
SvPADTMP_on(sv);
}
}
- if (has_args) {
- AV* av = newAV();
- av_extend(av, 0);
- av_store(newpad, 0, (SV*)av);
- AvFLAGS(av) = AVf_REIFY;
- }
+ av = newAV();
+ av_extend(av, 0);
+ av_store(newpad, 0, (SV*)av);
+ 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:
+ */