add CvSTASH_set() macro and make CvSTASH() rvalue only

Now that CvSTASH requires backreference bookkeeping, stop people from
directly assigning to it (by using CvSTASH() as an lvalue), and instead
force them to use CvSTASH_set().

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;