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 (file)
--- 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 (file)
--- 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 (file)
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);
+    }
+}