# define Nullcv Null(CV*)
#endif
-#define CvSTASH(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_stash
+#define CvSTASH(sv) (0+((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_stash)
+#define CvSTASH_set(cv,st) Perl_cvstash_set(aTHX_ cv, st)
#define CvSTART(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_start_u.xcv_start
#define CvROOT(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_root
#define CvXSUB(sv) ((XPVCV*)MUTABLE_PTR(SvANY(sv)))->xcv_root_u.xcv_xsub
: Used in scope.c
pMox |GP * |newGP |NN GV *const gv
pX |void |cvgv_set |NN CV* cv|NULLOK GV* gv
+pX |void |cvstash_set |NN CV* cv|NULLOK HV* stash
Ap |void |gv_init |NN GV* gv|NULLOK HV* stash|NN const char* name|STRLEN len|int multi
Ap |void |gv_name_set |NN GV* gv|NN const char *name|U32 len|U32 flags
XMpd |void |gv_try_downgrade|NN GV* gv
#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 delete_eval_scope() Perl_delete_eval_scope(aTHX)
#define die_unwind(a) Perl_die_unwind(aTHX_ a)
Perl_cv_set_call_checker
Perl_cv_undef
Perl_cvgv_set
+Perl_cvstash_set
Perl_cx_dump
Perl_cxinc
Perl_deb
}
}
+/* Assign CvSTASH(cv) = st, handling weak references. */
+
+void
+Perl_cvstash_set(pTHX_ CV *cv, HV *st)
+{
+ HV *oldst = CvSTASH(cv);
+ PERL_ARGS_ASSERT_CVSTASH_SET;
+ if (oldst == st)
+ return;
+ if (oldst)
+ sv_del_backref(MUTABLE_SV(oldst), MUTABLE_SV(cv));
+ SvANY(cv)->xcv_stash = st;
+ if (st)
+ Perl_sv_add_backref(aTHX_ MUTABLE_SV(st), MUTABLE_SV(cv));
+}
void
Perl_gv_init(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len, int multi)
mro_method_changed_in(GvSTASH(gv)); /* sub Foo::bar($) { (shift) } sub ASDF::baz($); *ASDF::baz = \&Foo::bar */
CvGV_set(cv, gv);
CvFILE_set_from_cop(cv, PL_curcop);
- CvSTASH(cv) = PL_curstash;
- if (PL_curstash)
- Perl_sv_add_backref(aTHX_ MUTABLE_SV(PL_curstash), MUTABLE_SV(cv));
+ CvSTASH_set(cv, PL_curstash);
if (proto) {
sv_usepvn_flags(MUTABLE_SV(cv), proto, protolen,
SV_HAS_TRAILING_NUL);
* and split that value on the last '::',
* pass along the same data via some unused fields in the CV
*/
- if (CvSTASH(cv))
- sv_del_backref(MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv));
- CvSTASH(cv) = stash;
- if (stash)
- Perl_sv_add_backref(aTHX_ MUTABLE_SV(stash), MUTABLE_SV(cv));
+ CvSTASH_set(cv, stash);
SvPV_set(cv, (char *)name); /* cast to lose constness warning */
SvCUR_set(cv, len);
return gv;
pad_fixup_inner_anons(CvPADLIST(cv), PL_compcv, cv);
if (PERLDB_INTER)/* Advice debugger on the new sub. */
++PL_sub_generation;
- if (CvSTASH(cv))
- sv_del_backref(MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv));
}
else {
/* Might have had built-in attributes applied -- propagate them. */
if (!CvGV(cv)) {
CvGV_set(cv, gv);
CvFILE_set_from_cop(cv, PL_curcop);
- CvSTASH(cv) = PL_curstash;
- if (PL_curstash)
- Perl_sv_add_backref(aTHX_ MUTABLE_SV(PL_curstash), MUTABLE_SV(cv));
+ CvSTASH_set(cv, PL_curstash);
}
if (attrs) {
/* Need to do a C<use attributes $stash_of_cv,\&cv,@attrs>. */
CvFILE(cv) = CvFILE(proto);
#endif
CvGV_set(cv,CvGV(proto));
- CvSTASH(cv) = CvSTASH(proto);
- if (CvSTASH(cv))
- Perl_sv_add_backref(aTHX_ MUTABLE_SV(CvSTASH(cv)), MUTABLE_SV(cv));
+ CvSTASH_set(cv, CvSTASH(proto));
OP_REFCNT_LOCK;
CvROOT(cv) = OpREFCNT_inc(CvROOT(proto));
OP_REFCNT_UNLOCK;
#define PERL_ARGS_ASSERT_CVGV_SET \
assert(cv)
+PERL_CALLCONV void Perl_cvstash_set(pTHX_ CV* cv, HV* stash)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_CVSTASH_SET \
+ assert(cv)
+
PERL_CALLCONV void Perl_cx_dump(pTHX_ PERL_CONTEXT* cx)
__attribute__nonnull__(pTHX_1);
#define PERL_ARGS_ASSERT_CX_DUMP \
/* You lookin' at me? */
assert(CvSTASH(referrer));
assert(CvSTASH(referrer) == (const HV *)sv);
- CvSTASH(referrer) = 0;
+ SvANY(MUTABLE_CV(referrer))->xcv_stash = 0;
}
else {
assert(SvTYPE(sv) == SVt_PVGV);
/*FALLTHROUGH*/
case SVt_PVFM:
/* NOTE: not refcounted */
- CvSTASH(dstr) = hv_dup(CvSTASH(dstr), param);
+ SvANY(MUTABLE_CV(dstr))->xcv_stash =
+ hv_dup(CvSTASH(dstr), param);
if ((param->flags & CLONEf_JOIN_IN) && CvSTASH(dstr))
Perl_sv_add_backref(aTHX_ MUTABLE_SV(CvSTASH(dstr)), dstr);
OP_REFCNT_LOCK;