From: Nicholas Clark <nick@ccl4.org>
Date: Thu, 20 Aug 2009 20:09:03 +0000 (+0100)
Subject: Optimise mro_get_linear_isa_c3() when there is a single parent. 40% speed up.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b0413f463ee989f4bfc29e4acfcfc4873d4dc3ce;p=p5sagit%2Fp5-mst-13.2.git

Optimise mro_get_linear_isa_c3() when there is a single parent. 40% speed up.

Idea blatantly copied from chromatic's analogous change to parrot, r38477.
---

diff --git a/MANIFEST b/MANIFEST
index 9cc4b3a..2fb8ee0 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -4130,6 +4130,7 @@ t/mro/complex_dfs.t		mro tests
 t/mro/dbic_c3.t			mro tests
 t/mro/dbic_dfs.t		mro tests
 t/mro/inconsistent_c3.t		mro tests
+t/mro/isa_c3.t			test for optimisatised mro_get_linear_isa_c3
 t/mro/isa_dfs.t			test for optimisatised mro_get_linear_isa_dfs
 t/mro/method_caching.t		mro tests
 t/mro/next_edgecases.t		mro tests
diff --git a/ext/mro/mro.xs b/ext/mro/mro.xs
index a4f6d6e..d9451b6 100644
--- a/ext/mro/mro.xs
+++ b/ext/mro/mro.xs
@@ -66,7 +66,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
     if(isa && AvFILLp(isa) >= 0) {
         SV** seqs_ptr;
         I32 seqs_items;
-        HV* const tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
+        HV *tails;
         AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
         I32* heads;
 
@@ -90,10 +90,49 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
                 /* recursion */
                 AV* const isa_lin
 		  = S_mro_get_linear_isa_c3(aTHX_ isa_item_stash, level + 1);
+
+		if(items == 0 && AvFILLp(seqs) == -1 && AvARRAY(isa_lin)) {
+		    /* Only one parent class. For this case, the C3
+		       linearisation is this class followed by the parent's
+		       inearisation, so don't bother with the expensive
+		       calculation.  */
+		    SV **svp;
+		    I32 subrv_items = AvFILLp(isa_lin) + 1;
+		    SV *const *subrv_p = AvARRAY(isa_lin);
+
+		    /* Hijack the allocated but unused array seqs to be the
+		       return value. It's currently mortalised.  */
+
+		    retval = seqs;
+
+		    av_extend(retval, subrv_items);
+		    AvFILLp(retval) = subrv_items;
+		    svp = AvARRAY(retval);
+
+		    /* First entry is this class.  We happen to make a shared
+		       hash key scalar because it's the cheapest and fastest
+		       way to do it.  */
+		    *svp++ = newSVhek(stashhek);
+
+		    while(subrv_items--) {
+			/* These values are unlikely to be shared hash key
+			   scalars, so no point in adding code to optimising
+			   for a case that is unlikely to be true.
+			   (Or prove me wrong and do it.)  */
+
+			SV *const val = *subrv_p++;
+			*svp++ = newSVsv(val);
+		    }
+
+		    SvREFCNT_inc(retval);
+
+		    goto done;
+		}
                 av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa_lin)));
             }
         }
         av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa)));
+	tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
 
         /* This builds "heads", which as an array of integer array
            indices, one per seq, which point at the virtual "head"
@@ -228,6 +267,7 @@ S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
         av_push(retval, newSVhek(stashhek));
     }
 
+ done:
     /* we don't want anyone modifying the cache entry but us,
        and we do so by replacing it completely */
     SvREADONLY_on(retval);
diff --git a/t/mro/isa_c3.t b/t/mro/isa_c3.t
new file mode 100644
index 0000000..713d10e
--- /dev/null
+++ b/t/mro/isa_c3.t
@@ -0,0 +1,69 @@
+#!perl -w
+
+BEGIN {
+    chdir 't' if -d 't';
+    @INC = '../lib';
+    require "./test.pl";
+}
+
+use strict;
+
+plan 'no_plan';
+
+# package klonk doesn't have a stash.
+
+package kapow;
+use mro 'c3';
+
+# No parents
+
+package urkkk;
+use mro 'c3';
+
+# 1 parent
+@urkkk::ISA = 'klonk';
+
+package kayo;
+use mro 'c3';
+
+# 2 parents
+@urkkk::ISA = ('klonk', 'kapow');
+
+package thwacke;
+use mro 'c3';
+
+# No parents, has @ISA
+@thwacke::ISA = ();
+
+package zzzzzwap;
+use mro 'c3';
+
+@zzzzzwap::ISA = ('thwacke', 'kapow');
+
+package whamm;
+use mro 'c3';
+
+@whamm::ISA = ('kapow', 'thwacke');
+
+package main;
+
+my %expect =
+    (
+     klonk => [qw(klonk)],
+     urkkk => [qw(urkkk klonk kapow)],
+     kapow => [qw(kapow)],
+     kayo => [qw(kayo)],
+     thwacke => [qw(thwacke)],
+     zzzzzwap => [qw(zzzzzwap thwacke kapow)],
+     whamm => [qw(whamm kapow thwacke)],
+    );
+
+foreach my $package (qw(klonk urkkk kapow kayo thwacke zzzzzwap whamm)) {
+    my $ref = bless [], $package;
+    my $isa = $expect{$package};
+    is("@{mro::get_linear_isa($package)}", "@$isa", "\@ISA for $package");
+
+    foreach my $class ($package, @$isa, 'UNIVERSAL') {
+	isa_ok($ref, $class, $package);
+    }
+}