From c68d956458c78806cbdba85dfe23247f62e143d5 Mon Sep 17 00:00:00 2001 From: Zefram Date: Mon, 25 Oct 2010 23:34:23 +0100 Subject: [PATCH] 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(). --- cv.h | 3 ++- embed.fnc | 1 + embed.h | 1 + global.sym | 1 + gv.c | 25 +++++++++++++++++-------- op.c | 6 +----- pad.c | 4 +--- proto.h | 5 +++++ sv.c | 5 +++-- 9 files changed, 32 insertions(+), 19 deletions(-) diff --git a/cv.h b/cv.h index e6f5cba..6fdf5cb 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 e08b76a..700e5da 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 10eba36..c17baef 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 d8eae72..692991d 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 6d55245..ab43177 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 21f8e97..cfa9d6b 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. */ diff --git a/pad.c b/pad.c index e945113..d395e71 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 c7f40cb..739ae41 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 88d022d..13fc40e 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; -- 2.7.4