The SVs in the names AV have their PV being the name of the variable.
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
+which the name is valid (accessed through the macros COP_SEQ_RANGE_LOW and
+_HIGH). During compilation, these fields may hold the special value
+PERL_PADSEQ_INTRO to indicate various stages:
+
+ COP_SEQ_RANGE_LOW _HIGH
+ ----------------- -----
+ PERL_PADSEQ_INTRO 0 variable not yet introduced: { my ($x
+ valid-seq# PERL_PADSEQ_INTRO variable in scope: { my ($x)
+ valid-seq# valid-seq# compilation of scope complete: { my ($x) }
+
+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
#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; /* XXX not threadsafe */
return (PADLIST*)padlist;
}
-/*
-=for apidoc pad_undef
-
-Free the padlist associated with a CV.
-If parts of it happen to be current, we null the relevant
-PL_*pad* global vars so that we don't have any dangling references left.
-We also repoint the CvOUTSIDE of any about-to-be-orphaned
-inner subs to the outer of this cv.
-
-(This function should really be called pad_free, but the name was already
-taken)
-
-=cut
-*/
-
-void
-Perl_pad_undef(pTHX_ CV* cv)
-{
- dVAR;
- I32 ix;
- const PADLIST * const padlist = CvPADLIST(cv);
-
- PERL_ARGS_ASSERT_PAD_UNDEF;
-
- pad_peg("pad_undef");
- if (!padlist)
- return;
- 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" comppad=0x%"UVxf"\n",
- PTR2UV(cv), PTR2UV(padlist), PTR2UV(PL_comppad))
- );
-
- /* detach any '&' anon children in the pad; if afterwards they
- * are still live, fix up their CvOUTSIDEs to point to our outside,
- * bypassing us. */
- /* XXX DAPM for efficiency, we should only do this if we know we have
- * children, or integrate this loop with general cleanup */
-
- if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
- CV * const outercv = CvOUTSIDE(cv);
- const U32 seq = CvOUTSIDE_SEQ(cv);
- AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
- SV ** const namepad = AvARRAY(comppad_name);
- AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
- SV ** const curpad = AvARRAY(comppad);
- for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
- SV * const namesv = namepad[ix];
- if (namesv && namesv != &PL_sv_undef
- && *SvPVX_const(namesv) == '&')
- {
- CV * const innercv = MUTABLE_CV(curpad[ix]);
- U32 inner_rc = SvREFCNT(innercv);
- assert(inner_rc);
- namepad[ix] = NULL;
- SvREFCNT_dec(namesv);
-
- 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));
- /* don't relink to grandfather if he's being freed */
- if (outercv && SvREFCNT(outercv)) {
- CvWEAKOUTSIDE_off(innercv);
- CvOUTSIDE(innercv) = outercv;
- CvOUTSIDE_SEQ(innercv) = seq;
- SvREFCNT_inc_simple_void_NN(outercv);
- }
- else {
- CvOUTSIDE(innercv) = NULL;
- }
- }
- }
- }
- }
-
- ix = AvFILLp(padlist);
- while (ix >= 0) {
- SV* const sv = AvARRAY(padlist)[ix--];
- if (sv) {
- if (sv == (const SV *)PL_comppad_name)
- PL_comppad_name = NULL;
- else if (sv == (const SV *)PL_comppad) {
- PL_comppad = NULL;
- PL_curpad = NULL;
- }
- }
- SvREFCNT_dec(sv);
- }
- SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
- CvPADLIST(cv) = NULL;
-}
-
/*
=head1 Embedding Functions
Perl_cv_undef(pTHX_ CV *cv)
{
dVAR;
+ const PADLIST *padlist = CvPADLIST(cv);
PERL_ARGS_ASSERT_CV_UNDEF;
SvPOK_off(MUTABLE_SV(cv)); /* forget prototype */
CvGV_set(cv, NULL);
- pad_undef(cv);
+ /* This statement and the subsequence if block was pad_undef(). */
+ pad_peg("pad_undef");
+
+ if (padlist && !SvIS_FREED(padlist) /* may be during global destruction */
+ ) {
+ I32 ix;
+
+ /* Free the padlist associated with a CV.
+ If parts of it happen to be current, we null the relevant PL_*pad*
+ global vars so that we don't have any dangling references left.
+ We also repoint the CvOUTSIDE of any about-to-be-orphaned inner
+ subs to the outer of this cv. */
+
+ DEBUG_X(PerlIO_printf(Perl_debug_log,
+ "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
+ * are still live, fix up their CvOUTSIDEs to point to our outside,
+ * bypassing us. */
+ /* XXX DAPM for efficiency, we should only do this if we know we have
+ * children, or integrate this loop with general cleanup */
+
+ if (PL_phase != PERL_PHASE_DESTRUCT) { /* don't bother during global destruction */
+ CV * const outercv = CvOUTSIDE(cv);
+ const U32 seq = CvOUTSIDE_SEQ(cv);
+ AV * const comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
+ SV ** const namepad = AvARRAY(comppad_name);
+ AV * const comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
+ SV ** const curpad = AvARRAY(comppad);
+ for (ix = AvFILLp(comppad_name); ix > 0; ix--) {
+ SV * const namesv = namepad[ix];
+ if (namesv && namesv != &PL_sv_undef
+ && *SvPVX_const(namesv) == '&')
+ {
+ CV * const innercv = MUTABLE_CV(curpad[ix]);
+ U32 inner_rc = SvREFCNT(innercv);
+ assert(inner_rc);
+ namepad[ix] = NULL;
+ SvREFCNT_dec(namesv);
+
+ 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));
+ /* don't relink to grandfather if he's being freed */
+ if (outercv && SvREFCNT(outercv)) {
+ CvWEAKOUTSIDE_off(innercv);
+ CvOUTSIDE(innercv) = outercv;
+ CvOUTSIDE_SEQ(innercv) = seq;
+ SvREFCNT_inc_simple_void_NN(outercv);
+ }
+ else {
+ CvOUTSIDE(innercv) = NULL;
+ }
+ }
+ }
+ }
+ }
+
+ ix = AvFILLp(padlist);
+ while (ix > 0) {
+ SV* const sv = AvARRAY(padlist)[ix--];
+ if (sv) {
+ if (sv == (const SV *)PL_comppad) {
+ PL_comppad = NULL;
+ PL_curpad = NULL;
+ }
+ SvREFCNT_dec(sv);
+ }
+ }
+ {
+ SV *const sv = AvARRAY(padlist)[0];
+ if (sv == (const SV *)PL_comppad_name)
+ PL_comppad_name = NULL;
+ SvREFCNT_dec(sv);
+ }
+ SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
+ CvPADLIST(cv) = NULL;
+ }
+
/* remove CvOUTSIDE unless this is an undef rather than a free */
if (!SvREFCNT(cv) && CvOUTSIDE(cv)) {
offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
/* not yet introduced */
- COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
- COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
+ COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
+ COP_SEQ_RANGE_HIGH_set(namesv, 0);
if (!PL_min_intro_pending)
PL_min_intro_pending = offset;
pad_peg("add_anon");
sv_setpvs(name, "&");
- /* Are these two actually ever read? */
- COP_SEQ_RANGE_HIGH_set(name, ~0);
- COP_SEQ_RANGE_LOW_set(name, 1);
+ /* These two aren't used; just make sure they're not equal to
+ * PERL_PADSEQ_INTRO */
+ COP_SEQ_RANGE_LOW_set(name, 0);
+ COP_SEQ_RANGE_HIGH_set(name, 0);
ix = pad_alloc(op_type, SVs_PADMY);
av_store(PL_comppad_name, ix, name);
/* XXX DAPM use PL_curpad[] ? */
if (sv
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
- && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
+ && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
+ || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
&& sv_eq(name, sv))
{
if (is_our && (SvPAD_OUR(sv)))
"\"%s\" variable %"SVf" masks earlier declaration in same %s",
(is_our ? "our" : PL_parser->in_my == KEY_my ? "my" : "state"),
sv,
- (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX ? "scope" : "statement"));
+ (COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO
+ ? "scope" : "statement"));
--off;
break;
}
}
/* check the rest of the pad */
if (is_our) {
- do {
+ while (off > 0) {
SV * const sv = svp[off];
if (sv
&& sv != &PL_sv_undef
&& !SvFAKE(sv)
- && (COP_SEQ_RANGE_HIGH(sv) == PAD_MAX || COP_SEQ_RANGE_HIGH(sv) == 0)
+ && ( COP_SEQ_RANGE_LOW(sv) == PERL_PADSEQ_INTRO
+ || COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
&& SvOURSTASH(sv) == ourstash
&& sv_eq(name, sv))
{
"\t(Did you mean \"local\" instead of \"our\"?)\n");
break;
}
- } while ( off-- > 0 );
+ --off;
+ }
}
}
&& !SvFAKE(namesv)
&& (SvPAD_OUR(namesv))
&& strEQ(SvPVX_const(namesv), name)
- && COP_SEQ_RANGE_LOW(namesv) == PAD_MAX /* min */
+ && COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
)
return offset;
}
po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
NULL, &namesv, &flags);
- if (po == NOT_IN_PAD
- || (SvFLAGS(namesv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
+ if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
return DEFSV;
return PAD_SVl(po);
if (namesv && namesv != &PL_sv_undef
&& strEQ(SvPVX_const(namesv), name))
{
- if (SvFAKE(namesv))
+ if (SvFAKE(namesv)) {
fake_offset = offset; /* in case we don't find a real one */
- else if ( seq > COP_SEQ_RANGE_LOW(namesv) /* min */
- && seq <= COP_SEQ_RANGE_HIGH(namesv)) /* max */
- break;
+ continue;
+ }
+ /* is seq within the range _LOW to _HIGH ?
+ * This is complicated by the fact that PL_cop_seqmax
+ * may have wrapped around at some point */
+ if (COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO)
+ continue; /* not yet introduced */
+
+ if (COP_SEQ_RANGE_HIGH(namesv) == PERL_PADSEQ_INTRO) {
+ /* in compiling scope */
+ if (
+ (seq > COP_SEQ_RANGE_LOW(namesv))
+ ? (seq - COP_SEQ_RANGE_LOW(namesv) < (U32_MAX >> 1))
+ : (COP_SEQ_RANGE_LOW(namesv) - seq > (U32_MAX >> 1))
+ )
+ break;
+ }
+ else if (
+ (COP_SEQ_RANGE_LOW(namesv) > COP_SEQ_RANGE_HIGH(namesv))
+ ?
+ ( seq > COP_SEQ_RANGE_LOW(namesv)
+ || seq <= COP_SEQ_RANGE_HIGH(namesv))
+
+ : ( seq > COP_SEQ_RANGE_LOW(namesv)
+ && seq <= COP_SEQ_RANGE_HIGH(namesv))
+ )
+ break;
}
}
* instances. For now, we just test !CvUNIQUE(cv), but
* ideally, we should detect my's declared within loops
* etc - this would allow a wider range of 'not stayed
- * shared' warnings. We also treated alreadly-compiled
+ * shared' warnings. We also treated already-compiled
* lexes as not multi as viewed from evals. */
*out_flags = CvANON(cv) ?
{
/* This relies on sv_setsv_flags() upgrading the destination to the same
- type as the source, independant of the flags set, and on it being
+ type as the source, independent of the flags set, and on it being
"good" and only copying flag bits and pointers that it understands.
*/
SV *new_namesv = newSVsv(*out_name_sv);
dVAR;
SV **svp;
I32 i;
+ U32 seq;
ASSERT_CURPAD_ACTIVE("intro_my");
if (! PL_min_intro_pending)
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) && !COP_SEQ_RANGE_HIGH(sv)) {
- COP_SEQ_RANGE_HIGH_set(sv, PAD_MAX); /* Don't know scope end yet. */
+ if (sv && sv != &PL_sv_undef && !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. */
COP_SEQ_RANGE_LOW_set(sv, PL_cop_seqmax);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad intromy: %ld \"%s\", (%lu,%lu)\n",
);
}
}
+ seq = PL_cop_seqmax;
+ PL_cop_seqmax++;
+ if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
+ PL_cop_seqmax++;
PL_min_intro_pending = 0;
PL_comppad_name_fill = PL_max_intro_pending; /* Needn't search higher */
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax+1)));
+ "Pad intromy: seq -> %ld\n", (long)(PL_cop_seqmax)));
- return PL_cop_seqmax++;
+ return seq;
}
/*
/* "Deintroduce" my variables that are leaving with this scope. */
for (off = AvFILLp(PL_comppad_name); off > PL_comppad_name_fill; off--) {
const SV * const sv = svp[off];
- if (sv && sv != &PL_sv_undef && !SvFAKE(sv) && COP_SEQ_RANGE_HIGH(sv) == PAD_MAX) {
+ if (sv && sv != &PL_sv_undef && !SvFAKE(sv)
+ && COP_SEQ_RANGE_HIGH(sv) == PERL_PADSEQ_INTRO)
+ {
COP_SEQ_RANGE_HIGH_set(sv, PL_cop_seqmax);
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad leavemy: %ld \"%s\", (%lu,%lu)\n",
}
}
PL_cop_seqmax++;
+ if (PL_cop_seqmax == PERL_PADSEQ_INTRO) /* not a legal value */
+ PL_cop_seqmax++;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
}
* 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
- * excuted within it.
+ * executed within it.
*/
if (PL_cv_has_eval || PL_perldb) {
if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
SvPADTMP_off(PL_curpad[po]);
-#ifdef USE_ITHREADS
- /* SV could be a shared hash key (eg bugid #19022) */
- if (!SvIsCOW(PL_curpad[po]))
- SvREADONLY_off(PL_curpad[po]); /* could be a freed constant */
-#endif
}
if ((I32)po < PL_padix)
PL_padix = po - 1;
CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
av_fill(PL_comppad, fpad);
- for (ix = fname; ix >= 0; ix--)
+ for (ix = fname; ix > 0; ix--)
av_store(PL_comppad_name, ix, SvREFCNT_inc(pname[ix]));
PL_curpad = AvARRAY(PL_comppad);
https://perl5.git.perl.org / perl5.git / blobdiff