From: Nicholas Clark Date: Fri, 12 Sep 2008 00:19:51 +0000 (+0000) Subject: Create a direct lookup hash for ->isa() lookup, by retaining the X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a49ba3fcbe357fbacf7b9898df08daa2cbdfc8c4;p=p5sagit%2Fp5-mst-13.2.git Create a direct lookup hash for ->isa() lookup, by retaining the de-duping hash used by S_mro_get_linear_isa_dfs(). Provide a new function Perl_get_isa_hash() to lazily retrieve this. (Which could actually be static if S_isa_lookup() and Perl_sv_derived_from() moved into mro.c.) Make S_isa_lookup() use this lookup hash in place of a linear walk of the linear isa. This should turn isa lookups from O(n) to O(1), which should make heavy users of ->isa() faster. (eg PPI, and hence Perl Critic). p4raw-id: //depot/perl@34354 --- diff --git a/embed.fnc b/embed.fnc index d680a5b..a193ab4 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1997,6 +1997,7 @@ ApoM |const char *|fetch_cop_label|NULLOK struct refcounted_he *const chain \ |NULLOK STRLEN *len|NULLOK U32 *flags xpoM |struct refcounted_he *|store_cop_label \ |NULLOK struct refcounted_he *const chain|NN const char *label +poM |HV * |get_isa_hash |NN HV *const stash END_EXTERN_C /* diff --git a/hv.c b/hv.c index c394e73..0cbb483 100644 --- a/hv.c +++ b/hv.c @@ -1688,6 +1688,7 @@ S_hfreeentries(pTHX_ HV *hv) if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs); if(meta->mro_linear_c3) SvREFCNT_dec(meta->mro_linear_c3); if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod); + SvREFCNT_dec(meta->isa); Safefree(meta); iter->xhv_mro_meta = NULL; } diff --git a/hv.h b/hv.h index e7d0c76..7f96a13 100644 --- a/hv.h +++ b/hv.h @@ -52,6 +52,7 @@ struct mro_meta { U32 cache_gen; /* Bumping this invalidates our method cache */ U32 pkg_gen; /* Bumps when local methods/@ISA change */ const struct mro_alg *mro_which; /* which mro alg is in use? */ + HV *isa; /* Everything this class @ISA */ }; /* Subject to change. diff --git a/mro.c b/mro.c index ffb72ab..da30c4d 100644 --- a/mro.c +++ b/mro.c @@ -88,12 +88,29 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param) if (newmeta->mro_nextmethod) newmeta->mro_nextmethod = (HV*) SvREFCNT_inc(sv_dup((SV*)newmeta->mro_nextmethod, param)); + if (newmeta->isa) + newmeta->isa + = (HV*) SvREFCNT_inc(sv_dup((SV*)newmeta->isa, param)); return newmeta; } #endif /* USE_ITHREADS */ +HV * +Perl_get_isa_hash(pTHX_ HV *const stash) +{ + dVAR; + struct mro_meta *const meta = HvMROMETA(stash); + + PERL_ARGS_ASSERT_GET_ISA_HASH; + + if (!meta->isa) + mro_get_linear_isa_dfs(stash, 0); + assert(meta->isa); + return meta->isa; +} + /* =for apidoc mro_get_linear_isa_dfs @@ -119,6 +136,8 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level) AV* av; const HEK* stashhek; struct mro_meta* meta; + SV *our_name; + HV *stored; PERL_ARGS_ASSERT_MRO_GET_LINEAR_ISA_DFS; assert(HvAUX(stash)); @@ -141,20 +160,25 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level) /* not in cache, make a new one */ retval = (AV*)sv_2mortal((SV *)newAV()); - av_push(retval, newSVhek(stashhek)); /* add ourselves at the top */ + /* We use this later in this function, but don't need a reference to it + beyond the end of this function, so reference count is fine. */ + our_name = newSVhek(stashhek); + av_push(retval, our_name); /* add ourselves at the top */ /* fetch our @ISA */ gvp = (GV**)hv_fetchs(stash, "ISA", FALSE); av = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL; - if(av && AvFILLp(av) >= 0) { + /* "stored" is used to keep track of all of the classnames we have added to + the MRO so far, so we can do a quick exists check and avoid adding + duplicate classnames to the MRO as we go. + It's then retained to be re-used as a fast lookup for ->isa(), by adding + our own name and "UNIVERSAL" to it. */ - /* "stored" is used to keep track of all of the classnames - we have added to the MRO so far, so we can do a quick - exists check and avoid adding duplicate classnames to - the MRO as we go. */ + stored = (HV*)sv_2mortal((SV*)newHV()); + + if(av && AvFILLp(av) >= 0) { - HV* const stored = (HV*)sv_2mortal((SV*)newHV()); SV **svp = AvARRAY(av); I32 items = AvFILLp(av) + 1; @@ -221,12 +245,19 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, I32 level) mortals' stack will be released soon, so everything will balance. */ SvREFCNT_inc_simple_void_NN(retval); SvTEMP_off(retval); + SvREFCNT_inc_simple_void_NN(stored); + SvTEMP_off(stored); + + hv_store_ent(stored, our_name, &PL_sv_undef, 0); + hv_store(stored, "UNIVERSAL", 9, &PL_sv_undef, 0); /* we don't want anyone modifying the cache entry but us, and we do so by replacing it completely */ SvREADONLY_on(retval); + SvREADONLY_on(stored); meta->mro_linear_dfs = retval; + meta->isa = stored; return retval; } diff --git a/proto.h b/proto.h index 59080ec..d106187 100644 --- a/proto.h +++ b/proto.h @@ -6597,6 +6597,11 @@ PERL_CALLCONV struct refcounted_he * Perl_store_cop_label(pTHX_ struct refcounte #define PERL_ARGS_ASSERT_STORE_COP_LABEL \ assert(label) +PERL_CALLCONV HV * Perl_get_isa_hash(pTHX_ HV *const stash) + __attribute__nonnull__(pTHX_1); +#define PERL_ARGS_ASSERT_GET_ISA_HASH \ + assert(stash) + END_EXTERN_C /* diff --git a/universal.c b/universal.c index 08dad15..de928f7 100644 --- a/universal.c +++ b/universal.c @@ -40,35 +40,32 @@ STATIC bool S_isa_lookup(pTHX_ HV *stash, const char * const name) { dVAR; - AV* stash_linear_isa; - SV** svp; - const char *hvname; - I32 items; - const HV *const name_stash = gv_stashpv(name, 0); + const struct mro_meta *const meta = HvMROMETA(stash); + HV *const isa = meta->isa ? meta->isa : Perl_get_isa_hash(aTHX_ stash); + STRLEN len = strlen(name); + const HV *our_stash; PERL_ARGS_ASSERT_ISA_LOOKUP; - /* A stash/class can go by many names (ie. User == main::User), so - we compare the stash itself just in case */ - if ((const HV *)stash == name_stash) - return TRUE; - - hvname = HvNAME_get(stash); - - if (strEQ(hvname, name)) + if (hv_common(isa, NULL, name, len, 0 /* No "UTF-8" flag possible with only + a char * argument*/, + HV_FETCH_ISEXISTS, NULL, 0)) { + /* Direct name lookup worked. */ return TRUE; + } - if (strEQ(name, "UNIVERSAL")) - return TRUE; + /* A stash/class can go by many names (ie. User == main::User), so + we use the name in the stash itself, which is canonical. */ + our_stash = gv_stashpvn(name, len, 0); - stash_linear_isa = mro_get_linear_isa(stash); - svp = AvARRAY(stash_linear_isa) + 1; - items = AvFILLp(stash_linear_isa); - while (items--) { - SV* const basename_sv = *svp++; - HV* const basestash = gv_stashsv(basename_sv, 0); - if(name_stash == basestash || strEQ(name, SvPVX(basename_sv))) + if (our_stash) { + HEK *const canon_name = HvNAME_HEK(our_stash); + + if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name), + HEK_FLAGS(canon_name), + HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) { return TRUE; + } } return FALSE;