develooper Front page | perl.perl5.porters | Postings from September 2008

O(1) ISA isa not as great as hoped (was Re: the warning about parents in Universal->isa)

Thread Previous | Thread Next
From:
Nicholas Clark
Date:
September 12, 2008 11:06
Subject:
O(1) ISA isa not as great as hoped (was Re: the warning about parents in Universal->isa)
Message ID:
20080912180604.GD80232@plum.flirble.org
On Fri, Aug 22, 2008 at 06:11:44PM +0300, Yuval Kogman wrote:
> On Fri, Aug 22, 2008 at 15:56:29 +0100, Nicholas Clark wrote:
> > To my mind it seems more logical behaviour that you ISA what you say you ISA,
> > always, rather than the intersection of what you say you are, and what is
> > loaded. After all, you get a warning (and probably an error) if you try to
> > do anything based on what you say you ISA if it's not loaded.
> 
> I find this warning annoying.
> 
> In Class::MOP anonymous classes are garbage collected, and their
> DESTROY handler deletes the stash (this is used for various runtime
> things).
> 
> During global destruction since GC the ordering is not guaranteed,
> superclasses can disappear before their subclasses, triggering this
> warning.

Well, it went as of change 34353. Because that then lets you do the appended,
which is to replace the linear search of (linear) @ISA with a hash lookup.
So this should turn ->isa from O(N) to O(1).

The reason all this came up was because at YAPC::EU Adam Kennedy asked me if
I'd seen Tim's talk on Devel::NYTProf at OSCON. (No I hadn't; I wasn't there)
Tim had profiled PPI, and (IIRC) it spends 15% of its time in UNIVERSAL::isa.
I'm told that the canonical test is to run Perl::Critic on itself.

The timing result of running (something like)

$ time ~/Sandpit/snap5.11.x-34353/bin/perl5.11.0 -MPerl::Critic=critique -lwe 'foreach (<>) {chomp; print STDERR $_; print critique($_)}' >34353.2 <files

before and after:

$ cat time.34353*
real    1m38.554s
user    1m36.520s
sys     0m0.260s
real    1m41.104s
user    1m37.740s
sys     0m0.270s
real    1m38.798s
user    1m35.740s
sys     0m0.340s
$ cat time.34356*
real    1m48.981s
user    1m33.900s
sys     0m0.290s
real    1m35.235s
user    1m31.340s
sys     0m0.340s
real    1m36.714s
user    1m32.330s
sys     0m0.270s


So it's using about 1% less CPU. :-)
Only :-(

Further thoughts?

Nicholas Clark


Change 34354 by nicholas@mouse-mill 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) ====

@@ -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) ====

@@ -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) ====

@@ -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) ====

@@ -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;
 
+    /* "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 = (HV*)sv_2mortal((SV*)newHV());
+
     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. */
-
-        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) ====

@@ -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) ====

@@ -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;
 
+    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;
+    }
+
     /* 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;
+       we use the name in the stash itself, which is canonical.  */
+    our_stash = gv_stashpvn(name, len, 0);
 
-    hvname = HvNAME_get(stash);
+    if (our_stash) {
+	HEK *const canon_name = HvNAME_HEK(our_stash);
 
-    if (strEQ(hvname, name))
-	return TRUE;
-
-    if (strEQ(name, "UNIVERSAL"))
-	return TRUE;
-
-    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 (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;

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About