X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=mro.c;h=2d528058262ed46e75bd4e6731d1604fd57e6071;hb=12964ddd5d77e0f02593286e5ca100221b0f8c59;hp=ed40bdd9d9e045ece9171b2292c05d96ff28bebf;hpb=190d0b226d68d16dfd6e8c8e99625bca713613f1;p=p5sagit%2Fp5-mst-13.2.git diff --git a/mro.c b/mro.c index ed40bdd..2d52805 100644 --- a/mro.c +++ b/mro.c @@ -54,7 +54,7 @@ Perl_mro_meta_init(pTHX_ HV* stash) { struct mro_meta* newmeta; - assert(stash); + PERL_ARGS_ASSERT_MRO_META_INIT; assert(HvAUX(stash)); assert(!(HvAUX(stash)->xhv_mro_meta)); Newxz(newmeta, 1, struct mro_meta); @@ -74,7 +74,7 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param) { struct mro_meta* newmeta; - assert(smeta); + PERL_ARGS_ASSERT_MRO_META_DUP; Newx(newmeta, 1, struct mro_meta); Copy(smeta, newmeta, 1, struct mro_meta); @@ -120,7 +120,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level) const HEK* stashhek; struct mro_meta* meta; - assert(stash); + PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS; assert(HvAUX(stash)); stashhek = HvNAME_HEK(stash); @@ -234,7 +234,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) const HEK* stashhek; struct mro_meta* meta; - assert(stash); + PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_C3; assert(HvAUX(stash)); stashhek = HvNAME_HEK(stash); @@ -313,12 +313,13 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, I32 level) SV** seq_ptr = AvARRAY(seq) + 1; while(seq_items--) { SV* const seqitem = *seq_ptr++; - HE* const he = hv_fetch_ent(tails, seqitem, 0, 0); - if(!he) { - (void)hv_store_ent(tails, seqitem, newSViv(1), 0); - } - else { + /* LVALUE fetch will create a new undefined SV if necessary + */ + HE* const he = hv_fetch_ent(tails, seqitem, 1, 0); + if(he) { SV* const val = HeVAL(he); + /* This will increment undef to 1, which is what we + want for a newly created entry. */ sv_inc(val); } } @@ -446,7 +447,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash) { struct mro_meta* meta; - assert(stash); + PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA; if(!SvOOK(stash)) Perl_croak(aTHX_ "Can't linearize anonymous symbol table"); @@ -480,6 +481,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) const char * const stashname = HvNAME_get(stash); const STRLEN stashname_len = HvNAMELEN_get(stash); + PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN; + if(!stashname) Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table"); @@ -517,8 +520,9 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) if(isarev) { hv_iterinit(isarev); while((iter = hv_iternext(isarev))) { - SV* const revkey = hv_iterkeysv(iter); - HV* revstash = gv_stashsv(revkey, 0); + I32 len; + const char* const revkey = hv_iterkey(iter, &len); + HV* revstash = gv_stashpvn(revkey, len, 0); struct mro_meta* revmeta; if(!revstash) continue; @@ -549,12 +553,16 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) SV* const sv = *svp++; HV* mroisarev; - HE *he = hv_fetch_ent(PL_isarev, sv, 0, 0); - if(!he) { - he = hv_store_ent(PL_isarev, sv, (SV*)newHV(), 0); - } + HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0); + + /* That fetch should not fail. But if it had to create a new SV for + us, then will need to upgrade it to an HV (which sv_upgrade() can + now do for us. */ + mroisarev = (HV*)HeVAL(he); + SvUPGRADE((SV*)mroisarev, SVt_PVHV); + /* This hash only ever contains PL_sv_yes. Storing it over itself is almost as cheap as calling hv_exists, so on aggregate we expect to save time by not making two calls to the common HV code for the @@ -612,6 +620,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0); HV * const isarev = svp ? (HV*)*svp : NULL; + PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN; + if(!stashname) Perl_croak(aTHX_ "Can't call mro_method_changed_in() on anonymous symbol table"); @@ -633,8 +643,9 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) hv_iterinit(isarev); while((iter = hv_iternext(isarev))) { - SV* const revkey = hv_iterkeysv(iter); - HV* const revstash = gv_stashsv(revkey, 0); + I32 len; + const char* const revkey = hv_iterkey(iter, &len); + HV* const revstash = gv_stashpvn(revkey, len, 0); struct mro_meta* mrometa; if(!revstash) continue; @@ -815,7 +826,7 @@ XS(XS_mro_get_isarev) while((iter = hv_iternext(isarev))) av_push(ret_array, newSVsv(hv_iterkeysv(iter))); } - XPUSHs(sv_2mortal(newRV_noinc((SV*)ret_array))); + mXPUSHs(newRV_noinc((SV*)ret_array)); PUTBACK; return; @@ -905,9 +916,7 @@ XS(XS_mro_get_pkg_gen) SP -= items; - XPUSHs(sv_2mortal(newSViv( - class_stash ? HvMROMETA(class_stash)->pkg_gen : 0 - ))); + mXPUSHi(class_stash ? HvMROMETA(class_stash)->pkg_gen : 0); PUTBACK; return; @@ -945,7 +954,7 @@ XS(XS_mro_nextcan) if(sv_isobject(self)) selfstash = SvSTASH(SvRV(self)); else - selfstash = gv_stashsv(self, 0); + selfstash = gv_stashsv(self, GV_ADD); assert(selfstash); @@ -1034,7 +1043,7 @@ XS(XS_mro_nextcan) Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname); XSRETURN_EMPTY; } - XPUSHs(sv_2mortal(newRV_inc(val))); + mXPUSHs(newRV_inc(val)); XSRETURN(1); } } @@ -1042,7 +1051,7 @@ XS(XS_mro_nextcan) /* beyond here is just for cache misses, so perf isn't as critical */ stashname_len = subname - fq_subname - 2; - stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len)); + stashname = newSVpvn_flags(fq_subname, stashname_len, SVs_TEMP); linear_av = mro_get_linear_isa_c3(selfstash, 0); /* has ourselves at the top of the list */ @@ -1095,7 +1104,7 @@ XS(XS_mro_nextcan) if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) { SvREFCNT_inc_simple_void_NN((SV*)cand_cv); (void)hv_store_ent(nmcache, newSVsv(sv), (SV*)cand_cv, 0); - XPUSHs(sv_2mortal(newRV_inc((SV*)cand_cv))); + mXPUSHs(newRV_inc((SV*)cand_cv)); XSRETURN(1); } }