/* pad.c
*
- * Copyright (C) 2002,2003 by Larry Wall and others
+ * Copyright (C) 2002, 2003, 2004, 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.
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();
+
=cut
*/
if (namesv && namesv != &PL_sv_undef
&& *SvPVX(namesv) == '&')
{
- CV *innercv = (CV*)curpad[ix];
+ CV * const innercv = (CV*)curpad[ix];
namepad[ix] = Nullsv;
SvREFCNT_dec(namesv);
- curpad[ix] = Nullsv;
- SvREFCNT_dec(innercv);
+
+ if (SvREFCNT(comppad) < 2) { /* allow for /(?{ sub{} })/ */
+ curpad[ix] = Nullsv;
+ SvREFCNT_dec(innercv);
+ }
if (SvREFCNT(innercv) /* in use, not just a prototype */
&& 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;
+ (void)SvREFCNT_inc(outercv);
}
else {
CvOUTSIDE(innercv) = Nullcv;
}
+
}
+
}
}
}
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)
+{
+ SV *out_sv;
+ int out_flags;
+ return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+ Null(SV**), &out_sv, &out_flags);
+}
/*
=for apidoc pad_findlex
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),
#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_SEQ(cv) = CvOUTSIDE_SEQ(proto);
=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;
AV *newpad = newAV();
SV **oldpad = AvARRAY(svp[depth-1]);
I32 ix = AvFILLp((AV*)svp[1]);
- I32 names_fill = AvFILLp((AV*)svp[0]);
+ const I32 names_fill = AvFILLp((AV*)svp[0]);
SV** names = AvARRAY(svp[0]);
- SV* sv;
+ 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(names[ix])[0];
+ if ((SvFLAGS(names[ix]) & SVf_FAKE) || 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, 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(oldpad[ix]));
}
else {
/* save temporaries on recursion? */
- av_store(newpad, ix, sv = NEWSV(0, 0));
+ SV *sv = NEWSV(0, 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);
+ AvFLAGS(av) = AVf_REIFY;
+
av_store(padlist, depth, (SV*)newpad);
AvFILLp(padlist) = depth;
}
projects / p5sagit/p5-mst-13.2.git / blobdiff