#define croak_xs_usage(a,b) Perl_croak_xs_usage(aTHX_ a,b)
#define custom_op_desc(a) Perl_custom_op_desc(aTHX_ a)
#define custom_op_name(a) Perl_custom_op_name(aTHX_ a)
+#define cv_clone(a) Perl_cv_clone(aTHX_ a)
#define cv_const_sv(a) Perl_cv_const_sv(aTHX_ a)
#define cv_get_call_checker(a,b,c) Perl_cv_get_call_checker(aTHX_ a,b,c)
#define cv_set_call_checker(a,b,c) Perl_cv_set_call_checker(aTHX_ a,b,c)
#define op_scope(a) Perl_op_scope(aTHX_ a)
#define pack_cat(a,b,c,d,e,f,g) Perl_pack_cat(aTHX_ a,b,c,d,e,f,g)
#define packlist(a,b,c,d,e) Perl_packlist(aTHX_ a,b,c,d,e)
-#define pad_findmy(a,b,c) Perl_pad_findmy(aTHX_ a,b,c)
+#define pad_add_anon(a,b) Perl_pad_add_anon(aTHX_ a,b)
+#define pad_add_name_pv(a,b,c,d) Perl_pad_add_name_pv(aTHX_ a,b,c,d)
+#define pad_add_name_pvn(a,b,c,d,e) Perl_pad_add_name_pvn(aTHX_ a,b,c,d,e)
+#define pad_add_name_sv(a,b,c,d) Perl_pad_add_name_sv(aTHX_ a,b,c,d)
+#define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b)
+#define pad_compname_type(a) Perl_pad_compname_type(aTHX_ a)
+#define pad_findmy_pv(a,b) Perl_pad_findmy_pv(aTHX_ a,b)
+#define pad_findmy_pvn(a,b,c) Perl_pad_findmy_pvn(aTHX_ a,b,c)
+#define pad_findmy_sv(a,b) Perl_pad_findmy_sv(aTHX_ a,b)
+#define pad_new(a) Perl_pad_new(aTHX_ a)
+#define pad_tidy(a) Perl_pad_tidy(aTHX_ a)
#define parse_arithexpr(a) Perl_parse_arithexpr(aTHX_ a)
#define parse_barestmt(a) Perl_parse_barestmt(aTHX_ a)
#define parse_block(a) Perl_parse_block(aTHX_ a)
#define my_bcopy Perl_my_bcopy
#endif
#if defined(DEBUGGING)
+#define pad_setsv(a,b) Perl_pad_setsv(aTHX_ a,b)
#define pad_sv(a) Perl_pad_sv(aTHX_ a)
#endif
#if defined(DUMP_FDS)
#define convert(a,b,c) Perl_convert(aTHX_ a,b,c)
#define create_eval_scope(a) Perl_create_eval_scope(aTHX_ a)
#define cv_ckproto_len(a,b,c,d) Perl_cv_ckproto_len(aTHX_ a,b,c,d)
-#define cv_clone(a) Perl_cv_clone(aTHX_ a)
#define cvgv_set(a,b) Perl_cvgv_set(aTHX_ a,b)
#define cvstash_set(a,b) Perl_cvstash_set(aTHX_ a,b)
#define deb_stack_all() Perl_deb_stack_all(aTHX)
#define oopsHV(a) Perl_oopsHV(aTHX_ a)
#define op_const_sv(a,b) Perl_op_const_sv(aTHX_ a,b)
#define package_version(a) Perl_package_version(aTHX_ a)
-#define pad_add_anon(a,b) Perl_pad_add_anon(aTHX_ a,b)
-#define pad_add_name(a,b,c,d,e) Perl_pad_add_name(aTHX_ a,b,c,d,e)
-#define pad_alloc(a,b) Perl_pad_alloc(aTHX_ a,b)
#define pad_block_start(a) Perl_pad_block_start(aTHX_ a)
-#define pad_compname_type(a) Perl_pad_compname_type(aTHX_ a)
#define pad_fixup_inner_anons(a,b,c) Perl_pad_fixup_inner_anons(aTHX_ a,b,c)
#define pad_free(a) Perl_pad_free(aTHX_ a)
#define pad_leavemy() Perl_pad_leavemy(aTHX)
-#define pad_new(a) Perl_pad_new(aTHX_ a)
#define pad_push(a,b) Perl_pad_push(aTHX_ a,b)
#define pad_swipe(a,b) Perl_pad_swipe(aTHX_ a,b)
-#define pad_tidy(a) Perl_pad_tidy(aTHX_ a)
#define parse_unicode_opts(a) Perl_parse_unicode_opts(aTHX_ a)
#define parser_free(a) Perl_parser_free(aTHX_ a)
#define peep(a) Perl_peep(aTHX_ a)
# endif
# if defined(DEBUGGING)
#define get_debug_opts(a,b) Perl_get_debug_opts(aTHX_ a,b)
-#define pad_setsv(a,b) Perl_pad_setsv(aTHX_ a,b)
# if defined(PERL_IN_PAD_C)
#define cv_dump(a,b) S_cv_dump(aTHX_ a,b)
# endif
#define too_many_arguments(a,b) S_too_many_arguments(aTHX_ a,b)
# endif
# if defined(PERL_IN_PAD_C)
-#define pad_add_name_sv(a,b,c,d) S_pad_add_name_sv(aTHX_ a,b,c,d)
+#define pad_alloc_name(a,b,c,d) S_pad_alloc_name(aTHX_ a,b,c,d)
#define pad_check_dup(a,b,c) S_pad_check_dup(aTHX_ a,b,c)
-#define pad_findlex(a,b,c,d,e,f,g) S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
+#define pad_findlex(a,b,c,d,e,f,g,h) S_pad_findlex(aTHX_ a,b,c,d,e,f,g,h)
#define pad_reset() S_pad_reset(aTHX)
# endif
# if defined(PERL_IN_PERL_C)
/*
=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 Amx|PADLIST *|CvPADLIST|CV *cv
-=for apidoc m|AV *|CvPADLIST|CV *cv
-CV's can have CvPADLIST(cv) set to point to an AV.
+CV's can have CvPADLIST(cv) set to point to an AV. This is the CV's
+scratchpad, which stores lexical variables and opcode temporary and
+per-thread values.
For these purposes "forms" are a kind-of CV, eval""s are too (except they're
not callable at will and are always thrown away after the eval"" is done
The 0'th slot of a frame AV is an AV which is @_.
other entries are storage for variables and op targets.
-During compilation:
-C<PL_comppad_name> is set to the names AV.
-C<PL_comppad> is set to the frame AV for the frame CvDEPTH == 1.
-C<PL_curpad> is set to the body of the frame AV (i.e. AvARRAY(PL_comppad)).
-
-During execution, C<PL_comppad> and C<PL_curpad> refer to the live
-frame of the currently executing sub.
-
Iterating over the names AV 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()).
For state vars, SVs_PADSTALE is overloaded to mean 'not yet initialised'
+=for apidoc AmxU|AV *|PL_comppad_name
+
+During compilation, this points to the array containing the names part
+of the pad for the currently-compiling code.
+
+=for apidoc AmxU|AV *|PL_comppad
+
+During compilation, this points to the array containing the values
+part of the pad for the currently-compiling code. (At runtime a CV may
+have many such value arrays; at compile time just one is constructed.)
+At runtime, this points to the array containing the currently-relevant
+values for the pad for the currently-executing code.
+
+=for apidoc AmxU|SV **|PL_curpad
+
+Points directly to the body of the L</PL_comppad> array.
+(I.e., this is C<AvARRAY(PL_comppad)>.)
+
=cut
*/
#define PARENT_FAKELEX_FLAGS_set(sv,val) \
STMT_START { ((XPVNV*)SvANY(sv))->xnv_u.xpad_cop_seq.xhigh = (val); } STMT_END
+/*
+=for apidoc mx|void|pad_peg|const char *s
+
+When PERL_MAD is enabled, this is a small no-op function that gets called
+at the start of each pad-related function. It can be breakpointed to
+track all pad operations. The parameter is a string indicating the type
+of pad operation being performed.
+
+=cut
+*/
+
#ifdef PERL_MAD
void pad_peg(const char* s) {
static int pegcnt; /* XXX not threadsafe */
#endif
/*
-=for apidoc pad_new
+=for apidoc Am|PADLIST *|pad_new|int flags
-Create a new compiling padlist, saving and updating the various global
-vars at the same time as creating the pad itself. The following flags
-can be OR'ed together:
+Create a new padlist, updating the global variables for the
+currently-compiling padlist to point to the new padlist. The following
+flags can be OR'ed together:
padnew_CLONE this pad is for a cloned CV
- padnew_SAVE save old globals
+ padnew_SAVE save old globals on the save stack
padnew_SAVESUB also save extra stuff for start of sub
=cut
CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
}
+/*
+=for apidoc m|PADOFFSET|pad_alloc_name|SV *namesv|U32 flags|HV *typestash|HV *ourstash
+
+Allocates a place in the currently-compiling pad (via L</pad_alloc>) and
+then stores a name for that entry. I<namesv> is adopted and becomes the
+name entry; it must already contain the name string and be sufficiently
+upgraded. I<typestash> and I<ourstash> and the C<padadd_STATE> flag get
+added to I<namesv>. None of the other processing of L</pad_add_name_pvn>
+is done. Returns the offset of the allocated pad slot.
+
+=cut
+*/
+
static PADOFFSET
-S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
- HV *ourstash)
+S_pad_alloc_name(pTHX_ SV *namesv, U32 flags, HV *typestash, HV *ourstash)
{
dVAR;
const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
- PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+ PERL_ARGS_ASSERT_PAD_ALLOC_NAME;
- ASSERT_CURPAD_ACTIVE("pad_add_name");
+ ASSERT_CURPAD_ACTIVE("pad_alloc_name");
if (typestash) {
assert(SvTYPE(namesv) == SVt_PVMG);
}
/*
-=for apidoc pad_add_name
+=for apidoc Am|PADOFFSET|pad_add_name_pvn|const char *namepv|STRLEN namelen|U32 flags|HV *typestash|HV *ourstash
-Create a new name and associated PADMY SV in the current pad; return the
-offset.
-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
-SvOURSTASH to that value
+Allocates a place in the currently-compiling pad for a named lexical
+variable. Stores the name and other metadata in the name part of the
+pad, and makes preparations to manage the variable's lexical scoping.
+Returns the offset of the allocated pad slot.
-If fake, it means we're cloning an existing entry
+I<namepv>/I<namelen> specify the variable's name, including leading sigil.
+If I<typestash> is non-null, the name is for a typed lexical, and this
+identifies the type. If I<ourstash> is non-null, it's a lexical reference
+to a package variable, and this identifies the package. The following
+flags can be OR'ed together:
+
+ padadd_OUR redundantly specifies if it's a package var
+ padadd_STATE variable will retain value persistently
+ padadd_NO_DUP_CHECK skip check for lexical shadowing
=cut
*/
PADOFFSET
-Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
- HV *typestash, HV *ourstash)
+Perl_pad_add_name_pvn(pTHX_ const char *namepv, STRLEN namelen,
+ U32 flags, HV *typestash, HV *ourstash)
{
dVAR;
PADOFFSET offset;
SV *namesv;
- PERL_ARGS_ASSERT_PAD_ADD_NAME;
+ PERL_ARGS_ASSERT_PAD_ADD_NAME_PVN;
if (flags & ~(padadd_OUR|padadd_STATE|padadd_NO_DUP_CHECK))
- Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
+ Perl_croak(aTHX_ "panic: pad_add_name_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
namesv = newSV_type((ourstash || typestash) ? SVt_PVMG : SVt_PVNV);
-
- /* Until we're using the length for real, cross check that we're being told
- the truth. */
- PERL_UNUSED_ARG(len);
- assert(strlen(name) == len);
-
- sv_setpv(namesv, name);
+ sv_setpvn(namesv, namepv, namelen);
if ((flags & padadd_NO_DUP_CHECK) == 0) {
/* check for duplicate declaration */
pad_check_dup(namesv, flags & padadd_OUR, ourstash);
}
- offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+ offset = pad_alloc_name(namesv, flags, typestash, ourstash);
/* not yet introduced */
COP_SEQ_RANGE_LOW_set(namesv, PERL_PADSEQ_INTRO);
/* if it's not a simple scalar, replace with an AV or HV */
assert(SvTYPE(PL_curpad[offset]) == SVt_NULL);
assert(SvREFCNT(PL_curpad[offset]) == 1);
- if (*name == '@')
+ if (namelen != 0 && *namepv == '@')
sv_upgrade(PL_curpad[offset], SVt_PVAV);
- else if (*name == '%')
+ else if (namelen != 0 && *namepv == '%')
sv_upgrade(PL_curpad[offset], SVt_PVHV);
assert(SvPADMY(PL_curpad[offset]));
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
- (long)offset, name, PTR2UV(PL_curpad[offset])));
+ (long)offset, SvPVX(namesv),
+ PTR2UV(PL_curpad[offset])));
return offset;
}
+/*
+=for apidoc Am|PADOFFSET|pad_add_name_pv|const char *name|U32 flags|HV *typestash|HV *ourstash
+Exactly like L</pad_add_name_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
+=cut
+*/
+
+PADOFFSET
+Perl_pad_add_name_pv(pTHX_ const char *name,
+ U32 flags, HV *typestash, HV *ourstash)
+{
+ PERL_ARGS_ASSERT_PAD_ADD_NAME_PV;
+ return pad_add_name_pvn(name, strlen(name), flags, typestash, ourstash);
+}
/*
-=for apidoc pad_alloc
+=for apidoc Am|PADOFFSET|pad_add_name_sv|SV *name|U32 flags|HV *typestash|HV *ourstash
-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 no active value.
+Exactly like L</pad_add_name_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_add_name_sv(pTHX_ SV *name, U32 flags, HV *typestash, HV *ourstash)
+{
+ char *namepv;
+ STRLEN namelen;
+ PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+ namepv = SvPV(name, namelen);
+ return pad_add_name_pvn(namepv, namelen, flags, typestash, ourstash);
+}
+
+/*
+=for apidoc Amx|PADOFFSET|pad_alloc|I32 optype|U32 tmptype
+
+Allocates a place in the currently-compiling pad,
+returning the offset of the allocated pad slot.
+No name is initially attached to the pad slot.
+I<tmptype> is a set of flags indicating the kind of pad entry required,
+which will be set in the value SV for the allocated pad entry:
+
+ SVs_PADMY named lexical variable ("my", "our", "state")
+ SVs_PADTMP unnamed temporary store
+
+I<optype> should be an opcode indicating the type of operation that the
+pad entry is to support. This doesn't affect operational semantics,
+but is used for debugging.
=cut
*/
if (PL_pad_reset_pending)
pad_reset();
if (tmptype & SVs_PADMY) {
+ /* For a my, simply push a null SV onto the end of PL_comppad. */
sv = *av_fetch(PL_comppad, AvFILLp(PL_comppad) + 1, TRUE);
retval = AvFILLp(PL_comppad);
}
else {
+ /* For a tmp, scan the pad from PL_padix upwards
+ * for a slot which has no name and no active value.
+ */
SV * const * const names = AvARRAY(PL_comppad_name);
const SSize_t names_fill = AvFILLp(PL_comppad_name);
for (;;) {
}
/*
-=for apidoc pad_add_anon
+=for apidoc Am|PADOFFSET|pad_add_anon|CV *func|I32 optype
-Add an anon code entry to the current compiling pad
+Allocates a place in the currently-compiling pad (via L</pad_alloc>)
+for an anonymous function that is lexically scoped inside the
+currently-compiling function.
+The function I<func> is linked into the pad, and its C<CvOUTSIDE> link
+to the outer scope is weakened to avoid a reference loop.
+
+I<optype> should be an opcode indicating the type of operation that the
+pad entry is to support. This doesn't affect operational semantics,
+but is used for debugging.
=cut
*/
PADOFFSET
-Perl_pad_add_anon(pTHX_ SV* sv, OPCODE op_type)
+Perl_pad_add_anon(pTHX_ CV* func, I32 optype)
{
dVAR;
PADOFFSET ix;
* PERL_PADSEQ_INTRO */
COP_SEQ_RANGE_LOW_set(name, 0);
COP_SEQ_RANGE_HIGH_set(name, 0);
- ix = pad_alloc(op_type, SVs_PADMY);
+ ix = pad_alloc(optype, SVs_PADMY);
av_store(PL_comppad_name, ix, name);
/* XXX DAPM use PL_curpad[] ? */
- av_store(PL_comppad, ix, sv);
- SvPADMY_on(sv);
+ av_store(PL_comppad, ix, (SV*)func);
+ SvPADMY_on((SV*)func);
/* to avoid ref loops, we never have parent + child referencing each
* other simultaneously */
- if (CvOUTSIDE((const CV *)sv)) {
- assert(!CvWEAKOUTSIDE((const CV *)sv));
- CvWEAKOUTSIDE_on(MUTABLE_CV(sv));
- SvREFCNT_dec(CvOUTSIDE(MUTABLE_CV(sv)));
+ if (CvOUTSIDE(func)) {
+ assert(!CvWEAKOUTSIDE(func));
+ CvWEAKOUTSIDE_on(func);
+ SvREFCNT_dec(CvOUTSIDE(func));
}
return ix;
}
-
-
/*
-=for apidoc pad_check_dup
+=for apidoc m|pad_check_dup|SV *name|U32 flags|const HV *ourstash
Check for duplicate declarations: report any of:
* a my in the current scope with the same name;
*/
STATIC void
-S_pad_check_dup(pTHX_ SV *name, const U32 flags, const HV *ourstash)
+S_pad_check_dup(pTHX_ SV *name, U32 flags, const HV *ourstash)
{
dVAR;
SV **svp;
/*
-=for apidoc pad_findmy
+=for apidoc Am|PADOFFSET|pad_findmy_pvn|const char *namepv|STRLEN namelen|U32 flags
-Given a lexical name, try to find its offset, first in the current pad,
-or failing that, in the pads of any lexically enclosing subs (including
-the complications introduced by eval). If the name is found in an outer pad,
-then a fake entry is added to the current pad.
-Returns the offset in the current pad, or NOT_IN_PAD on failure.
+Given the name of a lexical variable, find its position in the
+currently-compiling pad.
+I<namepv>/I<namelen> specify the variable's name, including leading sigil.
+I<flags> is reserved and must be zero.
+If it is not in the current pad but appears in the pad of any lexically
+enclosing scope, then a pseudo-entry for it is added in the current pad.
+Returns the offset in the current pad,
+or C<NOT_IN_PAD> if no such lexical is in scope.
=cut
*/
PADOFFSET
-Perl_pad_findmy(pTHX_ const char *name, STRLEN len, U32 flags)
+Perl_pad_findmy_pvn(pTHX_ const char *namepv, STRLEN namelen, U32 flags)
{
dVAR;
SV *out_sv;
const AV *nameav;
SV **name_svp;
- PERL_ARGS_ASSERT_PAD_FINDMY;
+ PERL_ARGS_ASSERT_PAD_FINDMY_PVN;
- pad_peg("pad_findmy");
+ pad_peg("pad_findmy_pvn");
if (flags)
- Perl_croak(aTHX_ "panic: pad_findmy illegal flag bits 0x%" UVxf,
+ Perl_croak(aTHX_ "panic: pad_findmy_pvn illegal flag bits 0x%" UVxf,
(UV)flags);
- /* Yes, it is a bug (read work in progress) that we're not really using this
- length parameter, and instead relying on strlen() later on. But I'm not
- comfortable about changing the pad API piecemeal to use and rely on
- lengths. This only exists to avoid an "unused parameter" warning. */
- if (len < 2)
- return NOT_IN_PAD;
-
- /* But until we're using the length for real, cross check that we're being
- told the truth. */
- assert(strlen(name) == len);
-
- offset = pad_findlex(name, PL_compcv, PL_cop_seqmax, 1,
+ offset = pad_findlex(namepv, namelen, PL_compcv, PL_cop_seqmax, 1,
NULL, &out_sv, &out_flags);
if ((PADOFFSET)offset != NOT_IN_PAD)
return offset;
if (namesv && namesv != &PL_sv_undef
&& !SvFAKE(namesv)
&& (SvPAD_OUR(namesv))
- && strEQ(SvPVX_const(namesv), name)
+ && SvCUR(namesv) == namelen
+ && memEQ(SvPVX_const(namesv), namepv, namelen)
&& COP_SEQ_RANGE_LOW(namesv) == PERL_PADSEQ_INTRO
)
return offset;
}
/*
- * Returns the offset of a lexical $_, if there is one, at run time.
- * Used by the UNDERBAR XS macro.
- */
+=for apidoc Am|PADOFFSET|pad_findmy_pv|const char *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes a nul-terminated string
+instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_findmy_pv(pTHX_ const char *name, U32 flags)
+{
+ PERL_ARGS_ASSERT_PAD_FINDMY_PV;
+ return pad_findmy_pvn(name, strlen(name), flags);
+}
+
+/*
+=for apidoc Am|PADOFFSET|pad_findmy_sv|SV *name|U32 flags
+
+Exactly like L</pad_findmy_pvn>, but takes the name string in the form
+of an SV instead of a string/length pair.
+
+=cut
+*/
+
+PADOFFSET
+Perl_pad_findmy_sv(pTHX_ SV *name, U32 flags)
+{
+ char *namepv;
+ STRLEN namelen;
+ PERL_ARGS_ASSERT_PAD_FINDMY_SV;
+ namepv = SvPV(name, namelen);
+ return pad_findmy_pvn(namepv, namelen, flags);
+}
+
+/*
+=for apidoc Amp|PADOFFSET|find_rundefsvoffset
+
+Find the position of the lexical C<$_> in the pad of the
+currently-executing function. Returns the offset in the current pad,
+or C<NOT_IN_PAD> if there is no lexical C<$_> in scope (in which case
+the global one should be used instead).
+L</find_rundefsv> is likely to be more convenient.
+
+=cut
+*/
PADOFFSET
Perl_find_rundefsvoffset(pTHX)
dVAR;
SV *out_sv;
int out_flags;
- return pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+ return pad_findlex("$_", 2, find_runcv(NULL), PL_curcop->cop_seq, 1,
NULL, &out_sv, &out_flags);
}
/*
- * Returns a lexical $_, if there is one, at run time ; or the global one
- * otherwise.
- */
+=for apidoc Am|SV *|find_rundefsv
+
+Find and return the variable that is named C<$_> in the lexical scope
+of the currently-executing function. This may be a lexical C<$_>,
+or will otherwise be the global one.
+
+=cut
+*/
SV *
Perl_find_rundefsv(pTHX)
int flags;
PADOFFSET po;
- po = pad_findlex("$_", find_runcv(NULL), PL_curcop->cop_seq, 1,
+ po = pad_findlex("$_", 2, find_runcv(NULL), PL_curcop->cop_seq, 1,
NULL, &namesv, &flags);
if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
}
/*
-=for apidoc pad_findlex
+=for apidoc m|PADOFFSET|pad_findlex|const char *namepv|STRLEN namelen|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
in the inner pads if it's found in an outer one.
STATIC PADOFFSET
-S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
- SV** out_capture, SV** out_name_sv, int *out_flags)
+S_pad_findlex(pTHX_ const char *namepv, STRLEN namelen, const CV* cv, U32 seq,
+ int warn, SV** out_capture, SV** out_name_sv, int *out_flags)
{
dVAR;
I32 offset, new_offset;
*out_flags = 0;
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad findlex cv=0x%"UVxf" searching \"%s\" seq=%d%s\n",
- PTR2UV(cv), name, (int)seq, out_capture ? " capturing" : "" ));
+ "Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
+ PTR2UV(cv), namelen, namepv, (int)seq,
+ out_capture ? " capturing" : "" ));
/* first, search this pad */
for (offset = AvFILLp(nameav); offset > 0; offset--) {
const SV * const namesv = name_svp[offset];
if (namesv && namesv != &PL_sv_undef
- && strEQ(SvPVX_const(namesv), name))
+ && SvCUR(namesv) == namelen
+ && memEQ(SvPVX_const(namesv), namepv, namelen))
{
if (SvFAKE(namesv)) {
fake_offset = offset; /* in case we don't find a real one */
{
if (warn)
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", name);
+ "Variable \"%.*s\" is not available",
+ namelen, namepv);
*out_capture = NULL;
}
&& warn && ckWARN(WARN_CLOSURE)) {
newwarn = 0;
Perl_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" will not stay shared", name);
+ "Variable \"%.*s\" will not stay shared",
+ namelen, namepv);
}
if (fake_offset && CvANON(cv)
"Pad findlex cv=0x%"UVxf" chasing lex in outer pad\n",
PTR2UV(cv)));
n = *out_name_sv;
- (void) pad_findlex(name, CvOUTSIDE(cv),
+ (void) pad_findlex(namepv, namelen, CvOUTSIDE(cv),
CvOUTSIDE_SEQ(cv),
newwarn, out_capture, out_name_sv, out_flags);
*out_name_sv = n;
&& !SvPAD_STATE(name_svp[offset]))
{
Perl_ck_warner(aTHX_ packWARN(WARN_CLOSURE),
- "Variable \"%s\" is not available", name);
+ "Variable \"%.*s\" is not available",
+ namelen, namepv);
*out_capture = NULL;
}
}
if (!*out_capture) {
- if (*name == '@')
+ if (namelen != 0 && *namepv == '@')
*out_capture = sv_2mortal(MUTABLE_SV(newAV()));
- else if (*name == '%')
+ else if (namelen != 0 && *namepv == '%')
*out_capture = sv_2mortal(MUTABLE_SV(newHV()));
else
*out_capture = sv_newmortal();
new_capturep = out_capture ? out_capture :
CvLATE(cv) ? NULL : &new_capture;
- offset = pad_findlex(name, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
+ offset = pad_findlex(namepv, namelen, CvOUTSIDE(cv), CvOUTSIDE_SEQ(cv), 1,
new_capturep, out_name_sv, out_flags);
if ((PADOFFSET)offset == NOT_IN_PAD)
return NOT_IN_PAD;
PL_curpad = AvARRAY(PL_comppad);
new_offset
- = pad_add_name_sv(new_namesv,
+ = pad_alloc_name(new_namesv,
(SvPAD_STATE(*out_name_sv) ? padadd_STATE : 0),
SvPAD_TYPED(*out_name_sv)
? SvSTASH(*out_name_sv) : NULL,
return new_offset;
}
-
#ifdef DEBUGGING
+
/*
-=for apidoc pad_sv
+=for apidoc Am|SV *|pad_sv|PADOFFSET po
-Get the value at offset po in the current pad.
+Get the value at offset I<po> in the current (compiling or executing) pad.
Use macro PAD_SV instead of calling this function directly.
=cut
*/
-
SV *
Perl_pad_sv(pTHX_ PADOFFSET po)
{
return PL_curpad[po];
}
-
/*
-=for apidoc pad_setsv
+=for apidoc Am|void|pad_setsv|PADOFFSET po|SV *sv
-Set the entry at offset po in the current pad to sv.
+Set the value at offset I<po> in the current (compiling or executing) pad.
Use the macro PAD_SETSV() rather than calling this function directly.
=cut
);
PL_curpad[po] = sv;
}
-#endif
-
+#endif /* DEBUGGING */
/*
-=for apidoc pad_block_start
+=for apidoc m|void|pad_block_start|int full
Update the pad compilation state variables on entry to a new block
PL_pad_reset_pending = FALSE;
}
-
/*
-=for apidoc intro_my
+=for apidoc m|U32|intro_my
"Introduce" my variables to visible status.
}
/*
-=for apidoc pad_leavemy
+=for apidoc m|void|pad_leavemy
Cleanup at end of scope during compilation: set the max seq number for
lexicals in this scope and warn of any lexicals that never got introduced.
"Pad leavemy: seq = %ld\n", (long)PL_cop_seqmax));
}
-
/*
-=for apidoc pad_swipe
+=for apidoc m|void|pad_swipe|PADOFFSET po|bool refadjust
Abandon the tmp in the current pad at offset po and replace with a
new one.
PL_padix = po - 1;
}
-
/*
-=for apidoc pad_reset
+=for apidoc m|void|pad_reset
Mark all the current temporaries for reuse
PL_pad_reset_pending = FALSE;
}
-
/*
-=for apidoc pad_tidy
+=for apidoc Amx|void|pad_tidy|padtidy_type type
+
+Tidy up a pad at the end of compilation of the code to which it belongs.
+Jobs performed here are: remove most stuff from the pads of anonsub
+prototypes; give it a @_; mark temporaries as such. I<type> indicates
+the kind of subroutine:
-Tidy up a pad after we've finished compiling it:
- * remove most stuff from the pads of anonsub prototypes;
- * give it a @_;
- * mark tmps as such.
+ padtidy_SUB ordinary subroutine
+ padtidy_SUBCLONE prototype for lexical closure
+ padtidy_FORMAT format
=cut
*/
PL_curpad = AvARRAY(PL_comppad);
}
-
/*
-=for apidoc pad_free
+=for apidoc m|void|pad_free|PADOFFSET po
Free the SV at offset po in the current pad.
PL_padix = po - 1;
}
-
-
/*
-=for apidoc do_dump_pad
+=for apidoc m|void|do_dump_pad|I32 level|PerlIO *file|PADLIST *padlist|int full
Dump the contents of a padlist
}
}
-
+#ifdef DEBUGGING
/*
-=for apidoc cv_dump
+=for apidoc m|void|cv_dump|CV *cv|const char *title
dump the contents of a CV
=cut
*/
-#ifdef DEBUGGING
STATIC void
S_cv_dump(pTHX_ const CV *cv, const char *title)
{
" PADLIST = 0x%"UVxf"\n", PTR2UV(padlist));
do_dump_pad(1, Perl_debug_log, padlist, 1);
}
-#endif /* DEBUGGING */
-
-
-
+#endif /* DEBUGGING */
/*
-=for apidoc cv_clone
+=for apidoc Am|CV *|cv_clone|CV *proto
-Clone a CV: make a new CV which points to the same code etc, but which
-has a newly-created pad built by copying the prototype pad and capturing
-any outer lexicals.
+Clone a CV, making a lexical closure. I<proto> supplies the prototype
+of the function: its code, pad structure, and other attributes.
+The prototype is combined with a capture of outer lexicals to which the
+code refers, which are taken from the currently-executing instance of
+the immediately surrounding code.
=cut
*/
return cv;
}
-
/*
-=for apidoc pad_fixup_inner_anons
+=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
}
}
-
/*
-=for apidoc pad_push
+=for apidoc m|void|pad_push|PADLIST *padlist|int depth
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. Then give
}
}
+/*
+=for apidoc Am|HV *|pad_compname_type|PADOFFSET po
+
+Looks up the type of the lexical variable at position I<po> in the
+currently-compiling pad. If the variable is typed, the stash of the
+class to which it is typed is returned. If not, C<NULL> is returned.
+
+=cut
+*/
HV *
Perl_pad_compname_type(pTHX_ const PADOFFSET po)
# define av_dup_inc(s,t) MUTABLE_AV(sv_dup_inc((const SV *)s,t))
+/*
+=for apidoc m|AV *|padlist_dup|AV *srcpad|CLONE_PARAMS *param
+
+Duplicates a pad.
+
+=cut
+*/
+
AV *
-Perl_padlist_dup(pTHX_ AV *const srcpad, CLONE_PARAMS *const param)
+Perl_padlist_dup(pTHX_ AV *srcpad, CLONE_PARAMS *param)
{
AV *dstpad;
PERL_ARGS_ASSERT_PADLIST_DUP;
return dstpad;
}
-#endif
+#endif /* USE_ITHREADS */
/*
* Local variables:
https://perl5.git.perl.org / perl5.git / commitdiff