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
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
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;
}
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
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;
}
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]);
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;
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;
}
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 {