summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--cv.h3
-rw-r--r--embed.fnc1
-rw-r--r--embed.h1
-rw-r--r--global.sym1
-rw-r--r--gv.c25
-rw-r--r--op.c6
-rw-r--r--pad.c4
-rw-r--r--proto.h5
-rw-r--r--sv.c5
9 files changed, 32 insertions, 19 deletions
diff --git a/cv.h b/cv.h
index e6f5cba9c6..6fdf5cbaf2 100644
--- a/cv.h
+++ b/cv.h
@@ -36,7 +36,8 @@ Returns the stash of the CV.
# 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
diff --git a/embed.fnc b/embed.fnc
index e08b76ac33..700e5da971 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -438,6 +438,7 @@ Ap |void |gv_fullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool
: 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
diff --git a/embed.h b/embed.h
index 10eba36ab0..c17baefa5b 100644
--- a/embed.h
+++ b/embed.h
@@ -960,6 +960,7 @@
#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)
diff --git a/global.sym b/global.sym
index d8eae72e92..692991dc08 100644
--- a/global.sym
+++ b/global.sym
@@ -72,6 +72,7 @@ Perl_cv_get_call_checker
Perl_cv_set_call_checker
Perl_cv_undef
Perl_cvgv_set
+Perl_cvstash_set
Perl_cx_dump
Perl_cxinc
Perl_deb
diff --git a/gv.c b/gv.c
index 6d55245ae8..ab431777ee 100644
--- a/gv.c
+++ b/gv.c
@@ -235,6 +235,21 @@ Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
}
}
+/* 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)
@@ -320,9 +335,7 @@ 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);
@@ -795,11 +808,7 @@ Perl_gv_autoload4(pTHX_ HV *stash, const char *name, STRLEN len, I32 method)
* 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;
diff --git a/op.c b/op.c
index 21f8e970bc..cfa9d6b686 100644
--- a/op.c
+++ b/op.c
@@ -6279,8 +6279,6 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
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. */
@@ -6308,9 +6306,7 @@ Perl_newATTRSUB(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs, OP *block)
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>. */
diff --git a/pad.c b/pad.c
index e945113a4a..d395e71dfe 100644
--- a/pad.c
+++ b/pad.c
@@ -1573,9 +1573,7 @@ Perl_cv_clone(pTHX_ CV *proto)
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;
diff --git a/proto.h b/proto.h
index c7f40cb63e..739ae416d8 100644
--- a/proto.h
+++ b/proto.h
@@ -602,6 +602,11 @@ PERL_CALLCONV void Perl_cvgv_set(pTHX_ CV* cv, GV* gv)
#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 \
diff --git a/sv.c b/sv.c
index 88d022d3eb..13fc40ee56 100644
--- a/sv.c
+++ b/sv.c
@@ -5558,7 +5558,7 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
/* 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);
@@ -11800,7 +11800,8 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
/*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;
View Lorry Controller Status