AV which is @_. Other entries are storage for variables and op targets.
Iterating over the PADNAMELIST iterates over all possible pad
-items. Pad slots that are SVs_PADTMP (targets/GVs/constants) end up having
-&PL_sv_undef "names" (see pad_alloc()).
+items. Pad slots for targets (SVs_PADTMP) and GVs end up having &PL_sv_no
+"names", while slots for constants have &PL_sv_no "names" (see
+pad_alloc()). That &PL_sv_no is used is an implementation detail subject
+to change. To test for it, use C<PadnamePV(name) && !PadnameLEN(name)>.
Only my/our variable (SvPADMY/PADNAME_isOUR) slots get valid names.
The rest are op targets/GVs/constants which are statically allocated
If PADNAME_OUTER (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,
+a REFCNT'ed reference to a lexical from "outside". In this case,
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
+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, xlow contains the index
within the parent's pad where the lexical's value is stored, to make
sv_recode_to_utf8(svrecode, PL_encoding);
pv1 = SvPV_const(svrecode, cur1);
}
- SvREFCNT_dec(svrecode);
+ SvREFCNT_dec_NN(svrecode);
}
if (flags & SVf_UTF8)
return (bytes_cmp_utf8(
else {
av_store(pad, 0, NULL);
padname = newAV();
+ AvPAD_NAMELIST_on(padname);
+ av_store(padname, 0, &PL_sv_undef);
}
/* Most subroutines never recurse, hence only need 2 entries in the padlist
=for apidoc cv_undef
-Clear out all the active components of a CV. This can happen either
+Clear out all the active components of a CV. This can happen either
by an explicit C<undef &foo>, or by the reference count going to zero.
In the former case, we keep the CvOUTSIDE pointer, so that any anonymous
children can still follow the full lexical scope chain.
PAD_SAVE_SETNULLPAD();
/* discard any leaked ops */
+ if (PL_parser)
+ parser_free_nexttoke_ops(PL_parser, (OPSLAB *)CvSTART(cv));
opslab_force_free((OPSLAB *)CvSTART(cv));
CvSTART(cv) = NULL;
if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
curpad[ix] = NULL;
- SvREFCNT_dec(innercv);
+ SvREFCNT_dec_NN(innercv);
inner_rc--;
}
PL_comppad = NULL;
PL_curpad = NULL;
}
- SvREFCNT_dec(sv);
+ SvREFCNT_dec_NN(sv);
}
}
{
}
av_store(PL_comppad_name, offset, namesv);
+ PadnamelistMAXNAMED(PL_comppad_name) = offset;
return offset;
}
flags &= ~padadd_UTF8_NAME;
if ((flags & padadd_NO_DUP_CHECK) == 0) {
+ ENTER;
+ SAVEFREESV(namesv); /* in case of fatal warnings */
/* check for duplicate declaration */
pad_check_dup(namesv, flags & padadd_OUR, ourstash);
+ SvREFCNT_inc_simple_void_NN(namesv);
+ LEAVE;
}
offset = pad_alloc_name(namesv, flags & ~padadd_UTF8_NAME, typestash, ourstash);
SVs_PADMY named lexical variable ("my", "our", "state")
SVs_PADTMP unnamed temporary store
+ SVf_READONLY constant shared between recursion levels
+
+C<SVf_READONLY> has been supported here only since perl 5.20. To work with
+earlier versions as well, use C<SVf_READONLY|SVs_PADTMP>. C<SVf_READONLY>
+does not cause the SV in the pad slot to be marked read-only, but simply
+tells C<pad_alloc> that it I<will> be made read-only (by the caller), or at
+least should be treated as such.
I<optype> should be an opcode indicating the type of operation that the
pad entry is to support. This doesn't affect operational semantics,
const SSize_t names_fill = AvFILLp(PL_comppad_name);
for (;;) {
/*
- * "foreach" index vars temporarily become aliases to non-"my"
- * values. Thus we must skip, not just pad values that are
+ * Entries that close over unavailable variables
+ * in outer subs contain values not marked PADMY.
+ * Thus we must skip, not just pad values that are
* marked as current pad values, but also those with names.
*/
- /* HVDS why copy to sv here? we don't seem to use it */
if (++PL_padix <= names_fill &&
(sv = names[PL_padix]) && sv != &PL_sv_undef)
continue;
sv = *av_fetch(PL_comppad, PL_padix, TRUE);
if (!(SvFLAGS(sv) & (SVs_PADTMP | SVs_PADMY)) &&
- !IS_PADGV(sv) && !IS_PADCONST(sv))
+ !IS_PADGV(sv))
break;
}
+ if (tmptype & SVf_READONLY) {
+ av_store(PL_comppad_name, PL_padix, &PL_sv_no);
+ tmptype &= ~SVf_READONLY;
+ tmptype |= SVs_PADTMP;
+ }
retval = PL_padix;
}
SvFLAGS(sv) |= tmptype;
if (CvOUTSIDE(func) && SvTYPE(func) == SVt_PVCV) {
assert(!CvWEAKOUTSIDE(func));
CvWEAKOUTSIDE_on(func);
- SvREFCNT_dec(CvOUTSIDE(func));
+ SvREFCNT_dec_NN(CvOUTSIDE(func));
}
return ix;
}
for (off = top; (I32)off > PL_comppad_name_floor; off--) {
SV * const sv = svp[off];
if (sv
- && sv != &PL_sv_undef
+ && PadnameLEN(sv)
&& !SvFAKE(sv)
&& ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
|| COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
while (off > 0) {
SV * const sv = svp[off];
if (sv
- && sv != &PL_sv_undef
+ && PadnameLEN(sv)
&& !SvFAKE(sv)
&& ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
|| COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
name_svp = AvARRAY(nameav);
for (offset = AvFILLp(nameav); offset > 0; offset--) {
const SV * const namesv = name_svp[offset];
- if (namesv && namesv != &PL_sv_undef
+ if (namesv && PadnameLEN(namesv) == namelen
&& !SvFAKE(namesv)
&& (SvPAD_OUR(namesv))
- && SvCUR(namesv) == namelen
&& sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
flags & padadd_UTF8_NAME ? SVf_UTF8 : 0 )
&& COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
/*
=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|U32 flags|const CV* cv|U32 seq|int warn|SV** out_capture|SV** out_name_sv|int *out_flags
-Find a named lexical anywhere in a chain of nested pads. Add fake entries
+Find a named lexical anywhere in a chain of nested pads. Add fake entries
in the inner pads if it's found in an outer one.
Returns the offset in the bottom pad of the lex or the fake lex.
cv is the CV in which to start the search, and seq is the current cop_seq
-to match against. If warn is true, print appropriate warnings. The out_*
+to match against. If warn is true, print appropriate warnings. The out_*
vars return values, and so are pointers to where the returned values
-should be stored. out_capture, if non-null, requests that the innermost
+should be stored. out_capture, if non-null, requests that the innermost
instance of the lexical is captured; out_name_sv is set to the innermost
matched namesv or fake namesv; out_flags returns the flags normally
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
+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 xlow the index into
the parent pad.
const AV * const nameav = PadlistARRAY(padlist)[0];
SV * const * const name_svp = AvARRAY(nameav);
- for (offset = AvFILLp(nameav); offset > 0; offset--) {
+ for (offset = PadnamelistMAXNAMED(nameav); offset > 0; offset--) {
const SV * const namesv = name_svp[offset];
- if (namesv && namesv != &PL_sv_undef
- && SvCUR(namesv) == namelen
+ if (namesv && PadnameLEN(namesv) == namelen
&& sv_eq_pvn_flags(aTHX_ namesv, namepv, namelen,
flags & padadd_UTF8_NAME ? SVf_UTF8 : 0))
{
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)
+ if (sv && PadnameLEN(sv) && !SvFAKE(sv)
&& COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO)
{
COP_SEQ_RANGE_HIGH_set(sv, PERL_PADSEQ_INTRO); /* Don't know scope end yet. */
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 * const sv = svp[off];
- if (sv && sv != &PL_sv_undef && !SvFAKE(sv))
+ if (sv && PadnameLEN(sv) && !SvFAKE(sv))
Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL),
"%"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--) {
SV * const sv = svp[off];
- if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+ if (sv && PadnameLEN(sv) && !SvFAKE(sv)
&& COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
{
COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
"Pad 0x%"UVxf"[0x%"UVxf"] swipe: %ld\n",
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po));
- if (PL_curpad[po])
- SvPADTMP_off(PL_curpad[po]);
if (refadjust)
SvREFCNT_dec(PL_curpad[po]);
PL_curpad[po] = newSV(0);
SvPADTMP_on(PL_curpad[po]);
#else
- PL_curpad[po] = &PL_sv_undef;
+ PL_curpad[po] = NULL;
#endif
+ if (PadnamelistMAX(PL_comppad_name) != -1
+ && (PADOFFSET)PadnamelistMAX(PL_comppad_name) >= po) {
+ if (PadnamelistARRAY(PL_comppad_name)[po]) {
+ assert(!PadnameLEN(PadnamelistARRAY(PL_comppad_name)[po]));
+ }
+ PadnamelistARRAY(PL_comppad_name)[po] = &PL_sv_undef;
+ }
if ((I32)po < PL_padix)
PL_padix = po - 1;
}
)
);
- if (!PL_tainting) { /* Can't mix tainted and non-tainted temporaries. */
+ if (!TAINTING_get) { /* Can't mix tainted and non-tainted temporaries. */
I32 po;
for (po = AvMAX(PL_comppad); po > PL_padix_floor; po--) {
if (PL_curpad[po] && !SvIMMORTAL(PL_curpad[po]))
ASSERT_CURPAD_ACTIVE("pad_tidy");
- /* If this CV has had any 'eval-capable' ops planted in it
- * (ie it contains eval '...', //ee, /$var/ or /(?{..})/), Then any
- * anon prototypes in the chain of CVs should be marked as cloneable,
- * so that for example the eval's CV in C<< sub { eval '$x' } >> gets
- * the right CvOUTSIDE.
- * If running with -d, *any* sub may potentially have an eval
- * executed within it.
+ /* If this CV has had any 'eval-capable' ops planted in it:
+ * i.e. it contains any of:
+ *
+ * * eval '...',
+ * * //ee,
+ * * use re 'eval'; /$var/
+ * * /(?{..})/),
+ *
+ * Then any anon prototypes in the chain of CVs should be marked as
+ * cloneable, so that for example the eval's CV in
+ *
+ * sub { eval '$x' }
+ *
+ * gets the right CvOUTSIDE. If running with -d, *any* sub may
+ * potentially have an eval executed within it.
*/
if (PL_cv_has_eval || PL_perldb) {
}
}
- /* extend curpad to match namepad */
+ /* extend namepad to match curpad */
if (AvFILLp(PL_comppad_name) < AvFILLp(PL_comppad))
av_store(PL_comppad_name, AvFILLp(PL_comppad), NULL);
if (type == padtidy_SUBCLONE) {
- SV * const * const namep = AvARRAY(PL_comppad_name);
+ SV ** const namep = AvARRAY(PL_comppad_name);
PADOFFSET ix;
for (ix = AvFILLp(PL_comppad); ix > 0; ix--) {
SV *namesv;
+ if (!namep[ix]) namep[ix] = &PL_sv_undef;
- if (SvIMMORTAL(PL_curpad[ix]) || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
- continue;
/*
* The only things that a clonable function needs in its
- * pad are anonymous subs.
+ * pad are anonymous subs, constants and GVs.
* The rest are created anew during cloning.
*/
- if (!((namesv = namep[ix]) != NULL &&
- namesv != &PL_sv_undef &&
- *SvPVX_const(namesv) == '&'))
+ if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
+ || IS_PADGV(PL_curpad[ix]))
+ continue;
+ namesv = namep[ix];
+ if (!(PadnamePV(namesv) &&
+ (!PadnameLEN(namesv) || *SvPVX_const(namesv) == '&')))
{
SvREFCNT_dec(PL_curpad[ix]);
PL_curpad[ix] = NULL;
}
if (type == padtidy_SUB || type == padtidy_FORMAT) {
- SV * const * const namep = AvARRAY(PL_comppad_name);
+ SV ** const namep = AvARRAY(PL_comppad_name);
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]))
+ if (!namep[ix]) namep[ix] = &PL_sv_undef;
+ if (!PL_curpad[ix] || SvIMMORTAL(PL_curpad[ix])
+ || IS_PADGV(PL_curpad[ix]) || IS_PADCONST(PL_curpad[ix]))
continue;
if (!SvPADMY(PL_curpad[ix])) {
SvPADTMP_on(PL_curpad[ix]);
Perl_pad_free(pTHX_ PADOFFSET po)
{
dVAR;
+ SV *sv;
ASSERT_CURPAD_LEGAL("pad_free");
if (!PL_curpad)
return;
PTR2UV(PL_comppad), PTR2UV(PL_curpad), (long)po)
);
- if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
- SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
- }
+
+ sv = PL_curpad[po];
+ if (sv && sv != &PL_sv_undef && !SvPADMY(sv))
+ SvFLAGS(sv) &= ~SVs_PADTMP;
+
if ((I32)po < PL_padix)
PL_padix = po - 1;
}
for (ix = 1; ix <= AvFILLp(pad_name); ix++) {
const SV *namesv = pname[ix];
- if (namesv && namesv == &PL_sv_undef) {
+ if (namesv && !PadnameLEN(namesv)) {
namesv = NULL;
}
if (namesv) {
static CV *S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside);
static void
-S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside)
+S_cv_clone_pad(pTHX_ CV *proto, CV *cv, CV *outside, bool newcv)
{
dVAR;
I32 ix;
|| PadlistNAMES(CvPADLIST(outside))
!= protopadlist->xpadl_outid) {
outside = find_runcv_where(
- FIND_RUNCV_padid_eq, (IV)protopadlist->xpadl_outid, NULL
+ FIND_RUNCV_padid_eq, PTR2IV(protopadlist->xpadl_outid), NULL
);
/* outside could be null */
}
ENTER;
SAVESPTR(PL_compcv);
PL_compcv = cv;
+ if (newcv) SAVEFREESV(cv); /* in case of fatal warnings */
if (CvHASEVAL(cv))
CvOUTSIDE(cv) = MUTABLE_CV(SvREFCNT_inc_simple(outside));
for (ix = fpad; ix > 0; ix--) {
SV* const namesv = (ix <= fname) ? pname[ix] : NULL;
SV *sv = NULL;
- if (namesv && namesv != &PL_sv_undef) { /* lexical */
+ if (namesv && PadnameLEN(namesv)) { /* lexical */
+ if (PadnameIsOUR(namesv)) { /* or maybe not so lexical */
+ NOOP;
+ }
+ else {
if (SvFAKE(namesv)) { /* lexical from outside? */
/* formats may have an inactive, or even undefined, parent;
but state vars are always available. */
if (sigil != '&' && SvPAD_STATE(namesv))
SvPADSTALE_on(sv);
}
+ }
}
- else if (IS_PADGV(ppad[ix]) || IS_PADCONST(ppad[ix])) {
+ else if (IS_PADGV(ppad[ix]) || (namesv && PadnamePV(namesv))) {
sv = SvREFCNT_inc_NN(ppad[ix]);
}
else {
S_cv_clone(aTHX_ (CV *)ppad[ix], (CV *)PL_curpad[ix], cv);
}
+ if (newcv) SvREFCNT_inc_simple_void_NN(cv);
LEAVE;
}
S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside)
{
dVAR;
+ const bool newcv = !cv;
assert(!CvUNIQUE(proto));
CvSTART(cv) = CvSTART(proto);
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(proto);
- if (SvPOK(proto))
+ if (SvPOK(proto)) {
sv_setpvn(MUTABLE_SV(cv), SvPVX_const(proto), SvCUR(proto));
+ if (SvUTF8(proto))
+ SvUTF8_on(MUTABLE_SV(cv));
+ }
if (SvMAGIC(proto))
mg_copy((SV *)proto, (SV *)cv, 0, 0);
- if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside);
+ if (CvPADLIST(proto)) S_cv_clone_pad(aTHX_ proto, cv, outside, newcv);
DEBUG_Xv(
PerlIO_printf(Perl_debug_log, "\nPad CV clone\n");
cv_dump(cv, "To");
);
- if (CvCONST(cv)) {
- /* Constant sub () { $x } closing over $x - see lib/constant.pm:
- * The prototype was marked as a candiate for const-ization,
- * so try to grab the current const value, and if successful,
- * turn into a const sub:
- */
- SV* const const_sv = op_const_sv(CvSTART(cv), cv);
- if (const_sv) {
- SvREFCNT_dec(cv);
- /* For this calling case, op_const_sv returns a *copy*, which we
- donate to newCONSTSUB. Yes, this is ugly, and should be killed.
- Need to fix how lib/constant.pm works to eliminate this. */
- cv = newCONSTSUB(CvSTASH(proto), NULL, const_sv);
- }
- else {
- CvCONST_off(cv);
- }
- }
-
return cv;
}
=for apidoc m|void|pad_fixup_inner_anons|PADLIST *padlist|CV *old_cv|CV *new_cv
For any anon CVs in the pad, change CvOUTSIDE of that CV from
-old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
+old_cv to new_cv if necessary. Needed when a newly-compiled CV has to be
moved to a pre-existing CV struct.
=cut
AV *av;
for ( ;ix > 0; ix--) {
- if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+ if (names_fill >= ix && PadnameLEN(names[ix])) {
const char sigil = SvPVX_const(names[ix])[0];
if ((SvFLAGS(names[ix]) & SVf_FAKE)
|| (SvFLAGS(names[ix]) & SVpad_STATE)
SvPADMY_on(sv);
}
}
- else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+ else if (IS_PADGV(oldpad[ix]) || PadnamePV(names[ix])) {
av_store(newpad, ix, SvREFCNT_inc_NN(oldpad[ix]));
}
else {
for ( ;ix > 0; ix--) {
if (!oldpad[ix]) {
pad1a[ix] = NULL;
- } else if (names_fill >= ix && names[ix] != &PL_sv_undef) {
+ } else if (names_fill >= ix && names[ix] &&
+ PadnameLEN(names[ix])) {
const char sigil = SvPVX_const(names[ix])[0];
if ((SvFLAGS(names[ix]) & SVf_FAKE)
|| (SvFLAGS(names[ix]) & SVpad_STATE)
}
}
}
- else if (IS_PADGV(oldpad[ix]) || IS_PADCONST(oldpad[ix])) {
+ else if (IS_PADGV(oldpad[ix])
+ || ( names_fill >= ix && names[ix]
+ && PadnamePV(names[ix]) )) {
pad1a[ix] = sv_dup_inc(oldpad[ix], param);
}
else {
#endif /* USE_ITHREADS */
PAD **
-Perl_padlist_store(pTHX_ register PADLIST *padlist, I32 key, PAD *val)
+Perl_padlist_store(pTHX_ PADLIST *padlist, I32 key, PAD *val)
{
dVAR;
PAD **ary;