Change 34354 by [EMAIL PROTECTED] on 2008/09/12 00:19:51
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).
Affected files ...
... //depot/perl/embed.fnc#618 edit
... //depot/perl/hv.c#379 edit
... //depot/perl/hv.h#124 edit
... //depot/perl/mro.c#50 edit
... //depot/perl/proto.h#952 edit
... //depot/perl/universal.c#199 edit
Differences ...
==== //depot/perl/embed.fnc#618 (text) ====
Index: perl/embed.fnc
--- perl/embed.fnc#617~34351~ 2008-09-11 14:27:43.000000000 -0700
+++ perl/embed.fnc 2008-09-11 17:19:51.000000000 -0700
@@ -1997,6 +1997,7 @@
|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
/*
==== //depot/perl/hv.c#379 (text) ====
Index: perl/hv.c
--- perl/hv.c#378~34338~ 2008-09-11 00:53:36.000000000 -0700
+++ perl/hv.c 2008-09-11 17:19:51.000000000 -0700
@@ -1688,6 +1688,7 @@
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;
}
==== //depot/perl/hv.h#124 (text) ====
Index: perl/hv.h
--- perl/hv.h#123~33891~ 2008-05-20 11:37:03.000000000 -0700
+++ perl/hv.h 2008-09-11 17:19:51.000000000 -0700
@@ -52,6 +52,7 @@
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.
==== //depot/perl/mro.c#50 (text) ====
Index: perl/mro.c
--- perl/mro.c#49~34215~ 2008-08-22 00:00:17.000000000 -0700
+++ perl/mro.c 2008-09-11 17:19:51.000000000 -0700
@@ -88,12 +88,29 @@
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 @@
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 @@
/* 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 @@
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;
}
==== //depot/perl/proto.h#952 (text+w) ====
Index: perl/proto.h
--- perl/proto.h#951~34351~ 2008-09-11 14:27:43.000000000 -0700
+++ perl/proto.h 2008-09-11 17:19:51.000000000 -0700
@@ -6597,6 +6597,11 @@
#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
/*
==== //depot/perl/universal.c#199 (text) ====
Index: perl/universal.c
--- perl/universal.c#198~34353~ 2008-09-11 15:11:32.000000000 -0700
+++ perl/universal.c 2008-09-11 17:19:51.000000000 -0700
@@ -40,35 +40,32 @@
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;
End of Patch.
