/* For use when you only have a XPVCV*, not a real CV*.
Must be assert protected as in S_CvDEPTHp before use. */
#define CvDEPTHunsafe(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_depth
-#define CvPADLIST(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist
+
+/* these CvPADLIST/CvRESERVED asserts can be reverted one day, once stabilized */
+#define CvPADLIST(sv) (*(assert_(!CvISXSUB((CV*)(sv))) \
+ &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist)))
+/* CvPADLIST_set is not public API, it can be removed one day, once stabilized */
+#ifdef DEBUGGING
+# define CvPADLIST_set(sv, padlist) Perl_set_padlist(aTHX_ (CV*)sv, padlist)
+#else
+# define CvPADLIST_set(sv, padlist) (CvPADLIST(sv) = (padlist))
+#endif
+/* CvRESERVED is a placeholder and will be going away soon */
+#define CvRESERVED(sv) *(assert_(CvISXSUB((CV*)(sv))) \
+ &(((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_reserved))
+#ifdef DEBUGGING
+# if PTRSIZE == 8
+# define PoisonPADLIST(sv) \
+ (((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist = (PADLIST *)UINT64_C(0xEFEFEFEFEFEFEFEF))
+# elif PTRSIZE == 4
+# define PoisonPADLIST(sv) \
+ (((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_padlist_u.xcv_padlist = (PADLIST *)0xEFEFEFEF)
+# else
+# error unknown pointer size
+# endif
+#else
+# define PoisonPADLIST(sv)
+#endif
+
#define CvOUTSIDE(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside
#define CvOUTSIDE_SEQ(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_outside_seq
#define CvFLAGS(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_flags
Perl_dump_indent(aTHX_ level, file, " DEPTH = %"IVdf"\n", (IV)CvDEPTH(sv));
Perl_dump_indent(aTHX_ level, file, " FLAGS = 0x%"UVxf"\n", (UV)CvFLAGS(sv));
Perl_dump_indent(aTHX_ level, file, " OUTSIDE_SEQ = %"UVuf"\n", (UV)CvOUTSIDE_SEQ(sv));
- Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
- if (nest < maxnest) {
- do_dump_pad(level+1, file, CvPADLIST(sv), 0);
+ if (!CvISXSUB(sv)) {
+ Perl_dump_indent(aTHX_ level, file, " PADLIST = 0x%"UVxf"\n", PTR2UV(CvPADLIST(sv)));
+ if (nest < maxnest) {
+ do_dump_pad(level+1, file, CvPADLIST(sv), 0);
+ }
}
+ else
+ Perl_dump_indent(aTHX_ level, file, " RESERVED = 0x%p\n", CvRESERVED(sv));
{
const CV * const outside = CvOUTSIDE(sv);
Perl_dump_indent(aTHX_ level, file, " OUTSIDE = 0x%"UVxf" (%s)\n",
: pad API
Apda |PADLIST*|pad_new |int flags
+#ifdef DEBUGGING
+pX |void|set_padlist| NN CV * cv | NULLOK PADLIST * padlist
+#endif
#if defined(PERL_IN_PAD_C)
s |PADOFFSET|pad_alloc_name|NN SV *namesv|U32 flags \
|NULLOK HV *typestash|NULLOK HV *ourstash
pdX |void |pad_push |NN PADLIST *padlist|int depth
ApdR |HV* |pad_compname_type|const PADOFFSET po
#if defined(USE_ITHREADS)
-pdR |PADLIST *|padlist_dup |NULLOK PADLIST *srcpad \
+pdR |PADLIST *|padlist_dup |NN PADLIST *srcpad \
|NN CLONE_PARAMS *param
#endif
p |PAD ** |padlist_store |NN PADLIST *padlist|I32 key \
# endif
# if defined(DEBUGGING)
#define get_debug_opts(a,b) Perl_get_debug_opts(aTHX_ a,b)
+#define set_padlist(a,b) Perl_set_padlist(aTHX_ a,b)
# if defined(PERL_IN_PAD_C)
#define cv_dump(a,b) S_cv_dump(aTHX_ a,b)
# endif
# walkoptree comes from B.xs
BEGIN {
- $B::VERSION = '1.52';
+ $B::VERSION = '1.53';
@B::EXPORT_OK = ();
# Our BOOT code needs $VERSION set, and will append to @EXPORT_OK.
B::PADLIST
CvPADLIST(cv)
B::CV cv
+ CODE:
+ RETVAL = CvISXSUB(cv) ? NULL : CvPADLIST(cv);
+ OUTPUT:
+ RETVAL
#else
#endif
+SV *
+CvRESERVED(cv)
+ B::CV cv
+ CODE:
+ RETVAL = newSViv(CvISXSUB(cv) ? PTR2IV(CvRESERVED(cv)) : 0);
+ OUTPUT:
+ RETVAL
+
void
CvXSUB(cv)
B::CV cv
package Devel::Peek;
-$VERSION = '1.18';
+$VERSION = '1.19';
$XS_VERSION = $VERSION;
$VERSION = eval $VERSION;
for (sv = sva + 1; sv < svend; ++sv) {
if (SvTYPE(sv) == SVt_PVCV) {
CV *cv = (CV*)sv;
- PADLIST* padlist = CvPADLIST(cv);
+ PADLIST* padlist;
AV *argav;
SV** svp;
SV** pad;
PerlIO_printf(Perl_debug_log, " busy\n");
continue;
}
+ padlist = CvPADLIST(cv);
svp = (SV**) PadlistARRAY(padlist);
while (++i <= PadlistMAX(padlist)) { /* Depth. */
SV **args;
FLAGS = 0xc # $] >= 5.013 && $] < 5.015
FLAGS = 0x100c # $] >= 5.015
OUTSIDE_SEQ = 0
- PADLIST = 0x0
+ PADLIST = 0x0 # $] < 5.021006
+ RESERVED = $ADDR # $] >= 5.021006
OUTSIDE = 0x0 \\(null\\)');
do_test('isUV should show on PVMG',
GvCVGEN(gv) = 0;
CvISXSUB_on(cv);
CvXSUB(cv) = core_xsub;
+ PoisonPADLIST(cv);
}
CvGV_set(cv, gv); /* This stops new ATTRSUB from setting CvFILE
from PL_curcop. */
Perl_debstackptrs
Perl_pad_sv
Perl_pad_setsv
+ Perl_set_padlist
Perl_hv_assert
PL_watchaddr
PL_watchok
CvXSUB(cv) = const_sv_xsub;
CvCONST_on(cv);
CvISXSUB_on(cv);
+ PoisonPADLIST(cv);
op_free(block);
SvREFCNT_dec(compcv);
PL_compcv = NULL;
CvFLAGS(compcv) | preserved_flags;
CvOUTSIDE(cv) = CvOUTSIDE(compcv);
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(compcv);
- CvPADLIST(cv) = CvPADLIST(compcv);
+ CvPADLIST_set(cv, CvPADLIST(compcv));
CvOUTSIDE(compcv) = temp_cv;
- CvPADLIST(compcv) = temp_padl;
+ CvPADLIST_set(compcv, temp_padl);
CvSTART(cv) = CvSTART(compcv);
CvSTART(compcv) = cvstart;
CvFLAGS(compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE);
CvXSUB(cv) = const_sv_xsub;
CvCONST_on(cv);
CvISXSUB_on(cv);
+ PoisonPADLIST(cv);
}
else {
if (isGV(gv)) {
| CvNAMED(cv);
CvOUTSIDE(cv) = CvOUTSIDE(PL_compcv);
CvOUTSIDE_SEQ(cv) = CvOUTSIDE_SEQ(PL_compcv);
- CvPADLIST(cv) = CvPADLIST(PL_compcv);
+ CvPADLIST_set(cv,CvPADLIST(PL_compcv));
CvOUTSIDE(PL_compcv) = temp_cv;
- CvPADLIST(PL_compcv) = temp_av;
+ CvPADLIST_set(PL_compcv, temp_av);
CvSTART(cv) = CvSTART(PL_compcv);
CvSTART(PL_compcv) = cvstart;
CvFLAGS(PL_compcv) &= ~(CVf_SLABBED|CVf_WEAKOUTSIDE);
assert(!CvDYNFILE(cv)); /* cv_undef should have turned it off */
CvISXSUB_on(cv);
CvXSUB(cv) = subaddr;
+ PoisonPADLIST(cv);
if (name)
process_special_blocks(0, name, gv, cv);
executing). Require'd files are simply evals without any outer lexical
scope.
-XSUBs don't have CvPADLIST set - dXSTARG fetches values from PL_curpad,
+XSUBs do not have a CvPADLIST. dXSTARG fetches values from PL_curpad,
but that is really the callers pad (a slot of which is allocated by
-every entersub).
+every entersub). Do not get or set CvPADLIST if a CV is an XSUB (as
+determined by C<CvISXSUB()>), CvPADLIST slot is reused for a different
+internal purpose in XSUBs.
The PADLIST has a C array where pads are stored.
|| memEQ(SvPVX_const(sv), pv, pvlen));
}
+#ifdef DEBUGGING
+void
+Perl_set_padlist(pTHX_ CV * cv, PADLIST *padlist){
+ PERL_ARGS_ASSERT_SET_PADLIST;
+# if PTRSIZE == 8
+ if((Size_t)padlist == UINT64_C(0xEFEFEFEFEFEFEFEF)){
+ assert(0);
+ }
+# elif PTRSIZE == 4
+ if((Size_t)padlist == UINT64_C(0xEFEFEFEF)){
+ assert(0);
+ }
+# else
+# error unknown pointer size
+# endif
+ if(CvISXSUB(cv)){
+ assert(0);
+ }
+ ((XPVCV*)MUTABLE_PTR(SvANY(cv)))->xcv_padlist_u.xcv_padlist = padlist;
+}
+#endif
/*
=for apidoc Am|PADLIST *|pad_new|int flags
/* This statement and the subsequence if block was pad_undef(). */
pad_peg("pad_undef");
- if (!CvISXSUB(&cvbody) && CvPADLIST(&cvbody)) {
+ if (!CvISXSUB(&cvbody) && CvPADLIST(&cvbody)) {
I32 ix;
const PADLIST *padlist = CvPADLIST(&cvbody);
}
if (PadlistARRAY(padlist)) Safefree(PadlistARRAY(padlist));
Safefree(padlist);
- CvPADLIST(&cvbody) = NULL;
+ CvPADLIST_set(&cvbody, NULL);
}
- else /* future union */
- CvPADLIST(&cvbody) = NULL;
+ else if (CvISXSUB(&cvbody)) /* future union */
+ CvRESERVED(&cvbody) = NULL;
+ /* else is (!CvISXSUB(&cvbody) && !CvPADLIST(&cvbody)) {do nothing;} */
/* remove CvOUTSIDE unless this is an undef rather than a free */
SAVESPTR(PL_comppad_name);
PL_comppad_name = protopad_name;
- CvPADLIST(cv) = pad_new(padnew_CLONE|padnew_SAVE);
+ CvPADLIST_set(cv, pad_new(padnew_CLONE|padnew_SAVE));
av_fill(PL_comppad, fpad);
PERL_ARGS_ASSERT_PADLIST_DUP;
- if (!srcpad)
- return NULL;
-
cloneall = param->flags & CLONEf_COPY_STACKS
|| SvREFCNT(PadlistARRAY(srcpad)[1]) > 1;
assert (SvREFCNT(PadlistARRAY(srcpad)[1]) == 1);
PL_main_cv = PL_compcv = MUTABLE_CV(newSV_type(SVt_PVCV));
CvUNIQUE_on(PL_compcv);
- CvPADLIST(PL_compcv) = pad_new(0);
+ CvPADLIST_set(PL_compcv, pad_new(0));
PL_isarev = newHV();
=item *
-XXX
+Starting in 5.21.6, accessing L<perlapi/CvPADLIST> in an XSUB is forbidden.
+CvPADLIST has be reused for a different internal purpose for XSUBs. Guard all
+CvPADLIST expressions with C<CvISXSUB()> if your code doesn't already block
+XSUB CV*s from going through optree CV* expecting code.
=back
/* set up a scratch pad */
- CvPADLIST(evalcv) = pad_new(padnew_SAVE);
+ CvPADLIST_set(evalcv, pad_new(padnew_SAVE));
PL_op = NULL; /* avoid PL_op and PL_curpad referring to different CVs */
assert(sv)
PERL_CALLCONV SV* Perl_pad_sv(pTHX_ PADOFFSET po);
+PERL_CALLCONV void Perl_set_padlist(pTHX_ CV * cv, PADLIST * padlist)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_SET_PADLIST \
+ assert(cv)
+
# if defined(PERL_IN_PAD_C)
STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title)
__attribute__nonnull__(pTHX_1)
PERL_CALLCONV PADLIST * Perl_padlist_dup(pTHX_ PADLIST *srcpad, CLONE_PARAMS *param)
__attribute__warn_unused_result__
+ __attribute__nonnull__(pTHX_1)
__attribute__nonnull__(pTHX_2);
#define PERL_ARGS_ASSERT_PADLIST_DUP \
- assert(param)
+ assert(srcpad); assert(param)
PERL_CALLCONV yy_parser* Perl_parser_dup(pTHX_ const yy_parser *const proto, CLONE_PARAMS *const param)
__attribute__nonnull__(pTHX_2);
? NULL
: gv_dup(CvGV(sstr), param);
- CvPADLIST(dstr) = padlist_dup(CvPADLIST(sstr), param);
+ if (!CvISXSUB(sstr)) {
+ if(CvPADLIST(sstr))
+ CvPADLIST_set(dstr, padlist_dup(CvPADLIST(sstr), param));
+ else
+ CvPADLIST_set(dstr, NULL);
+ } else { /* future union here */
+ CvRESERVED(dstr) = NULL;
+ }
CvOUTSIDE(dstr) =
CvWEAKOUTSIDE(sstr)
? cv_dup( CvOUTSIDE(dstr), param)
HEK * xcv_hek; \
} xcv_gv_u; \
char * xcv_file; \
- PADLIST * xcv_padlist; \
+ union { \
+ PADLIST * xcv_padlist; \
+ void * xcv_reserved; \
+ } xcv_padlist_u; \
CV * xcv_outside; \
U32 xcv_outside_seq; /* the COP sequence (at the point of our \
* compilation) in the lexically enclosing \
CvFLAGS(PL_compcv) |= flags;
PL_subline = CopLINE(PL_curcop);
- CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
+ CvPADLIST_set(PL_compcv, pad_new(padnew_SAVE|padnew_SAVESUB));
CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outsidecv));
CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
if (outsidecv && CvPADLIST(outsidecv))