diff options
| -rw-r--r-- | embed.fnc | 3 | ||||
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | hv.h | 10 | ||||
| -rw-r--r-- | mro.c | 42 | ||||
| -rw-r--r-- | proto.h | 2 |
5 files changed, 31 insertions, 28 deletions
@@ -2664,7 +2664,8 @@ sd |AV* |mro_get_linear_isa_dfs|NN HV* stash|U32 level s |void |mro_clean_isarev|NN HV * const isa \ |NN const char * const name \ |const STRLEN len \ - |NULLOK HV * const exceptions|U32 flags + |NULLOK HV * const exceptions \ + |U32 hash|U32 flags s |void |mro_gather_and_rename|NN HV * const stashes \ |NN HV * const seen_stashes \ |NULLOK HV *stash \ @@ -1429,7 +1429,7 @@ #define translate_substr_offsets(a,b,c,d,e,f,g) Perl_translate_substr_offsets(aTHX_ a,b,c,d,e,f,g) # endif # if defined(PERL_IN_MRO_C) -#define mro_clean_isarev(a,b,c,d,e) S_mro_clean_isarev(aTHX_ a,b,c,d,e) +#define mro_clean_isarev(a,b,c,d,e,f) S_mro_clean_isarev(aTHX_ a,b,c,d,e,f) #define mro_gather_and_rename(a,b,c,d,e) S_mro_gather_and_rename(aTHX_ a,b,c,d,e) #define mro_get_linear_isa_dfs(a,b) S_mro_get_linear_isa_dfs(aTHX_ a,b) # endif @@ -471,6 +471,16 @@ C<SV*>. (flags) | HV_DELETE, NULL, 0))) #ifdef PERL_CORE +# define hv_storehek(hv, hek, val) \ + hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ + HV_FETCH_ISSTORE|HV_FETCH_JUST_SV, (val), HEK_HASH(hek)) +# define hv_fetchhek(hv, hek, lval) \ + ((SV **) \ + hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ + (lval) \ + ? (HV_FETCH_JUST_SV | HV_FETCH_LVALUE) \ + : HV_FETCH_JUST_SV, \ + NULL, HEK_HASH(hek))) # define hv_deletehek(hv, hek, flags) \ hv_common((hv), NULL, HEK_KEY(hek), HEK_LEN(hek), HEK_UTF8(hek), \ (flags)|HV_DELETE, NULL, HEK_HASH(hek)) @@ -502,9 +502,9 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) struct mro_meta * meta; HV *isa = NULL; + const HEK * const stashhek = HvENAME_HEK(stash); const char * const stashname = HvENAME_get(stash); const STRLEN stashname_len = HvENAMELEN_get(stash); - const bool stashname_utf8 = HvENAMEUTF8(stash) ? 1 : 0; PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN; @@ -527,8 +527,7 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) /* Wipe the global method cache if this package is UNIVERSAL or one of its parents */ - svp = hv_fetch(PL_isarev, stashname, - stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, 0); + svp = hv_fetchhek(PL_isarev, stashhek, 0); isarev = svp ? MUTABLE_HV(*svp) : NULL; if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL")) @@ -634,17 +633,14 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) it doesn't exist. */ (void) - hv_store( - mroisarev, HEK_KEY(namehek), - HEK_UTF8(namehek) ? -HEK_LEN(namehek) : HEK_LEN(namehek), - &PL_sv_yes, 0 - ); + hv_storehek(mroisarev, namehek, &PL_sv_yes); } if((SV *)isa != &PL_sv_undef) mro_clean_isarev( isa, HEK_KEY(namehek), HEK_LEN(namehek), - HvMROMETA(revstash)->isa, (HEK_UTF8(namehek) ? SVf_UTF8 : 0) + HvMROMETA(revstash)->isa, HEK_HASH(namehek), + HEK_UTF8(namehek) ); } } @@ -678,20 +674,20 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) save time by not making two calls to the common HV code for the case where it doesn't exist. */ - (void)hv_store(mroisarev, stashname, - stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, &PL_sv_yes, 0); + (void)hv_storehek(mroisarev, stashhek, &PL_sv_yes); } /* Delete our name from our former parents' isarevs. */ if(isa && HvARRAY(isa)) mro_clean_isarev(isa, stashname, stashname_len, meta->isa, - (stashname_utf8 ? SVf_UTF8 : 0) ); + HEK_HASH(stashhek), HEK_UTF8(stashhek)); } /* Deletes name from all the isarev entries listed in isa */ STATIC void S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name, - const STRLEN len, HV * const exceptions, U32 flags) + const STRLEN len, HV * const exceptions, U32 hash, + U32 flags) { HE* iter; @@ -708,7 +704,8 @@ S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name, svp = hv_fetch(PL_isarev, key, HeKUTF8(iter) ? -klen : klen, 0); if(svp) { HV * const isarev = (HV *)*svp; - (void)hv_delete(isarev, name, (flags & SVf_UTF8) ? -(I32)len : (I32)len, G_DISCARD); + (void)hv_common(isarev, NULL, name, len, flags, + G_DISCARD|HV_DELETE, NULL, hash); if(!HvARRAY(isarev) || !HvUSEDKEYS(isarev)) (void)hv_delete(PL_isarev, key, HeKUTF8(iter) ? -klen : klen, G_DISCARD); @@ -777,8 +774,7 @@ Perl_mro_package_moved(pTHX_ HV * const stash, HV * const oldstash, SV **svp; if( !GvSTASH(gv) || !HvENAME(GvSTASH(gv)) || - !(svp = hv_fetch(GvSTASH(gv), GvNAME(gv), - GvNAMEUTF8(gv) ? -GvNAMELEN(gv) : GvNAMELEN(gv), 0)) || + !(svp = hv_fetchhek(GvSTASH(gv), GvNAME_HEK(gv), 0)) || *svp != (SV *)gv ) return; } @@ -978,7 +974,8 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, * fies it for us, so sv_2mortal is not necessary. */ if(HvENAME_HEK(oldstash) != enamehek) { if(meta->isa && HvARRAY(meta->isa)) - mro_clean_isarev(meta->isa, name, len, 0, name_utf8); + mro_clean_isarev(meta->isa, name, len, 0, 0, + name_utf8 ? HVhek_UTF8 : 0); isarev = (HV *)hv_delete(PL_isarev, name, name_utf8 ? -(I32)len : (I32)len, 0); fetched_isarev=TRUE; @@ -1064,12 +1061,9 @@ S_mro_gather_and_rename(pTHX_ HV * const stashes, HV * const seen_stashes, assert(!oldstash || HvENAME(oldstash)); if (oldstash) { /* Extra variable to avoid a compiler warning */ - char * const hvename = HvENAME(oldstash); + const HEK * const hvename = HvENAME_HEK(oldstash); fetched_isarev = TRUE; - svp = hv_fetch(PL_isarev, hvename, - HvENAMEUTF8(oldstash) - ? -HvENAMELEN_get(oldstash) - : HvENAMELEN_get(oldstash), 0); + svp = hv_fetchhek(PL_isarev, hvename, 0); if (svp) isarev = MUTABLE_HV(*svp); } else if(SvTYPE(namesv) == SVt_PVAV) { @@ -1320,10 +1314,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) { const char * const stashname = HvENAME_get(stash); const STRLEN stashname_len = HvENAMELEN_get(stash); - const bool stashname_utf8 = HvENAMEUTF8(stash) ? 1 : 0; - SV ** const svp = hv_fetch(PL_isarev, stashname, - stashname_utf8 ? -(I32)stashname_len : (I32)stashname_len, 0); + SV ** const svp = hv_fetchhek(PL_isarev, HvENAME_HEK(stash), 0); HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL; PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN; @@ -5910,7 +5910,7 @@ PERL_CALLCONV bool Perl_translate_substr_offsets(pTHX_ STRLEN curlen, IV pos1_iv #endif #if defined(PERL_IN_MRO_C) -STATIC void S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name, const STRLEN len, HV * const exceptions, U32 flags) +STATIC void S_mro_clean_isarev(pTHX_ HV * const isa, const char * const name, const STRLEN len, HV * const exceptions, U32 hash, U32 flags) __attribute__nonnull__(pTHX_1) __attribute__nonnull__(pTHX_2); #define PERL_ARGS_ASSERT_MRO_CLEAN_ISAREV \ |