but that is really the callers pad (a slot of which is allocated by
every entersub).
-The CvPADLIST AV has does not have AvREAL set, so REFCNT of component items
-is managed "manual" (mostly in pad.c) rather than normal av.c rules.
+The CvPADLIST AV has the REFCNT of its component items managed "manually"
+(mostly in pad.c) rather than by normal av.c rules. So we turn off AvREAL
+just before freeing it, to let av.c know not to touch the entries.
The items in the AV are not SVs as for a normal AV, but other AVs:
0'th Entry of the CvPADLIST is an AV which represents the "names" or rather
and bytes checking.
*/
-STATIC I32
-sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const I32 pvlen, const U32 flags) {
+static bool
+sv_eq_pvn_flags(pTHX_ const SV *sv, const char* pv, const STRLEN pvlen, const U32 flags) {
if ( (SvUTF8(sv) & SVf_UTF8 ) != (flags & SVf_UTF8) ) {
const char *pv1 = SvPVX_const(sv);
STRLEN cur1 = SvCUR(sv);
av_store(pad, 0, NULL);
}
- AvREAL_off(padlist);
/* Most subroutines never recurse, hence only need 2 entries in the padlist
array - names, and depth=1. The default for av_store() is to allocate
0..3, and even an explicit call to av_extend() with <3 will be rounded
PTR2UV(cv), PTR2UV(PL_comppad))
);
-#ifdef USE_ITHREADS
- if (CvFILE(cv) && !CvISXSUB(cv)) {
- /* for XSUBs CvFILE point directly to static memory; __FILE__ */
+ if (CvFILE(cv) && CvDYNFILE(cv)) {
Safefree(CvFILE(cv));
}
CvFILE(cv) = NULL;
-#endif
if (!CvISXSUB(cv) && CvROOT(cv)) {
if (SvTYPE(cv) == SVt_PVCV && CvDEPTH(cv))
PL_comppad_name = NULL;
SvREFCNT_dec(sv);
}
+ AvREAL_off(CvPADLIST(cv));
SvREFCNT_dec(MUTABLE_SV(CvPADLIST(cv)));
CvPADLIST(cv) = NULL;
}
CvXSUB(cv) = NULL;
}
/* delete all flags except WEAKOUTSIDE and CVGV_RC, which indicate the
- * ref status of CvOUTSIDE and CvGV */
- CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC);
+ * ref status of CvOUTSIDE and CvGV, and ANON, which pp_entersub uses
+ * to choose an error message */
+ CvFLAGS(cv) &= (CVf_WEAKOUTSIDE|CVf_CVGV_RC|CVf_ANON);
}
/*
=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
+Allocates a place in the currently-compiling
+pad (via L<perlapi/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>
+added to I<namesv>. None of the other
+processing of L<perlapi/pad_add_name_pvn>
is done. Returns the offset of the allocated pad slot.
=cut
PADOFFSET
Perl_pad_add_name_pv(pTHX_ const char *name,
- U32 flags, HV *typestash, HV *ourstash)
+ const 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 m|pad_check_dup|SV *name|U32 flags|const HV *ourstash
+=for apidoc pad_check_dup
Check for duplicate declarations: report any of:
+
* a my in the current scope with the same name;
- * an our (anywhere in the pad) with the same name and the same stash
- as C<ourstash>
-C<is_our> indicates that the name to check is an 'our' declaration
+ * an our (anywhere in the pad) with the same name and the
+ same stash as C<ourstash>
+
+C<is_our> indicates that the name to check is an 'our' declaration.
=cut
*/
return PAD_SVl(po);
}
+SV *
+Perl_find_rundefsv2(pTHX_ CV *cv, U32 seq)
+{
+ SV *namesv;
+ int flags;
+ PADOFFSET po;
+
+ PERL_ARGS_ASSERT_FIND_RUNDEFSV2;
+
+ po = pad_findlex("$_", 2, 0, cv, seq, 1,
+ NULL, &namesv, &flags);
+
+ if (po == NOT_IN_PAD || SvPAD_OUR(namesv))
+ return DEFSV;
+
+ return AvARRAY((PAD*) (AvARRAY(CvPADLIST(cv))[CvDEPTH(cv)]))[po];
+}
+
/*
=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
DEBUG_Xv(PerlIO_printf(Perl_debug_log,
"Pad findlex cv=0x%"UVxf" searching \"%.*s\" seq=%d%s\n",
- PTR2UV(cv), namelen, namepv, (int)seq,
+ PTR2UV(cv), (int)namelen, namepv, (int)seq,
out_capture ? " capturing" : "" ));
/* first, search this pad */
);
if (PL_curpad[po] && PL_curpad[po] != &PL_sv_undef) {
- SvPADTMP_off(PL_curpad[po]);
+ SvFLAGS(PL_curpad[po]) &= ~SVs_PADTMP; /* also clears SVs_PADSTALE */
}
if ((I32)po < PL_padix)
PL_padix = po - 1;
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC);
CvCLONED_on(cv);
-#ifdef USE_ITHREADS
- CvFILE(cv) = CvISXSUB(proto) ? CvFILE(proto)
- : savepv(CvFILE(proto));
-#else
- CvFILE(cv) = CvFILE(proto);
-#endif
+ CvFILE(cv) = CvDYNFILE(proto) ? savepv(CvFILE(proto))
+ : CvFILE(proto);
CvGV_set(cv,CvGV(proto));
CvSTASH_set(cv, CvSTASH(proto));
OP_REFCNT_LOCK;
if (!srcpad)
return NULL;
- assert(!AvREAL(srcpad));
-
if (param->flags & CLONEf_COPY_STACKS
|| SvREFCNT(AvARRAY(srcpad)[1]) > 1) {
- /* XXX padlists are real, but pretend to be not */
- AvREAL_on(srcpad);
dstpad = av_dup_inc(srcpad, param);
- AvREAL_off(srcpad);
- AvREAL_off(dstpad);
assert (SvREFCNT(AvARRAY(srcpad)[1]) == 1);
} else {
/* CvDEPTH() on our subroutine will be set to 0, so there's no need
SV **names;
SV **pad1a;
AV *args;
- /* look for it in the table first.
- I *think* that it shouldn't be possible to find it there.
- Well, except for how Perl_sv_compile_2op() "works" :-( */
+ /* Look for it in the table first, as the padlist may have ended up
+ as an element of @DB::args (or theoretically even @_), so it may
+ may have been cloned already. It may also be there because of
+ how Perl_sv_compile_2op() "works". :-( */
dstpad = (AV*)ptr_table_fetch(PL_ptr_table, srcpad);
if (dstpad)
- return dstpad;
+ return (AV *)SvREFCNT_inc_simple_NN(dstpad);
dstpad = newAV();
ptr_table_store(PL_ptr_table, srcpad, dstpad);
- AvREAL_off(dstpad);
av_extend(dstpad, 1);
AvARRAY(dstpad)[0] = MUTABLE_SV(av_dup_inc(AvARRAY(srcpad)[0], param));
names = AvARRAY(AvARRAY(dstpad)[0]);
https://perl5.git.perl.org / perl5.git / blobdiff