X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FClass-C3-XS.git;a=blobdiff_plain;f=XS.xs;h=1ad66143340ea15f7e9c8dc1813339fb2a8acb53;hp=c51452463dc59f0cb600343cebdbb398ff30ee4f;hb=eeeb4071329047dfee7aa27e4ec447f35e61e64a;hpb=6c88cc6a6051a67355d64366d2fd83bf65cb7070

diff --git a/XS.xs b/XS.xs
index c514524..1ad6614 100644
--- a/XS.xs
+++ b/XS.xs
@@ -3,6 +3,57 @@
 #include "perl.h"
 #include "XSUB.h"
 
+/* *********** ppport stuff */
+
+#ifndef PERL_UNUSED_VAR
+#  define PERL_UNUSED_VAR(x) ((void)x)
+#endif
+
+#if defined(PERL_GCC_PEDANTIC)
+#  ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
+#    define PERL_GCC_BRACE_GROUPS_FORBIDDEN
+#  endif
+#endif
+
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
+#  ifndef PERL_USE_GCC_BRACE_GROUPS
+#    define PERL_USE_GCC_BRACE_GROUPS
+#  endif
+#endif
+
+#ifndef SvREFCNT_inc
+#  ifdef PERL_USE_GCC_BRACE_GROUPS
+#    define SvREFCNT_inc(sv) \
+      ({ \
+          SV * const _sv = (SV*)(sv); \
+          if (_sv) \
+               (SvREFCNT(_sv))++; \
+          _sv; \
+      })
+#  else
+#    define SvREFCNT_inc(sv) \
+          ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
+#  endif
+#endif
+
+#ifndef dAX
+#  define dAX                            I32 ax = MARK - PL_stack_base + 1
+#endif
+
+#ifndef dVAR
+#  define dVAR                           dNOOP
+#endif
+
+#ifndef packWARN
+#  define packWARN(a)                    (a)
+#endif
+
+/* *********** end ppport.h stuff */
+
+#ifndef SVfARG
+#  define SVfARG(p)                      ((void*)(p))
+#endif
+
 /* Most of this code is backported from the bleadperl patch's
    mro.c, and then modified to work with Class::C3's
    internals.
@@ -17,9 +68,9 @@ __mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
     AV* isa;
     const char* stashname;
     STRLEN stashname_len;
+    I32 made_mortal_cache = 0;
 
     assert(stash);
-    assert(HvAUX(stash));
 
     stashname = HvNAME(stash);
     stashname_len = strlen(stashname);
@@ -33,6 +84,7 @@ __mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
 
     if(!cache) {
         cache = (HV*)sv_2mortal((SV*)newHV());
+        made_mortal_cache = 1;
     }
     else {
         SV** cache_entry = hv_fetch(cache, stashname, stashname_len, 0);
@@ -42,100 +94,183 @@ __mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
 
     /* not in cache, make a new one */
 
-    retval = (AV*)sv_2mortal((SV*)newAV());
-    av_push(retval, newSVpvn(stashname, stashname_len)); /* us first */
-
     gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
     isa = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL;
-
     if(isa && AvFILLp(isa) >= 0) {
         SV** seqs_ptr;
         I32 seqs_items;
-        HV* tails = (HV*)sv_2mortal((SV*)newHV());
-        AV* seqs = (AV*)sv_2mortal((SV*)newAV());
+        HV* const tails = (HV*)sv_2mortal((SV*)newHV());
+        AV* const seqs = (AV*)sv_2mortal((SV*)newAV());
+        I32* heads;
+
+        /* This builds @seqs, which is an array of arrays.
+           The members of @seqs are the MROs of
+           the members of @ISA, followed by @ISA itself.
+        */
         I32 items = AvFILLp(isa) + 1;
         SV** isa_ptr = AvARRAY(isa);
         while(items--) {
-            AV* isa_lin;
-            SV* isa_item = *isa_ptr++;
-            HV* isa_item_stash = gv_stashsv(isa_item, 0);
+            SV* const isa_item = *isa_ptr++;
+            HV* const isa_item_stash = gv_stashsv(isa_item, 0);
             if(!isa_item_stash) {
-                isa_lin = newAV();
+                /* if no stash, make a temporary fake MRO
+                   containing just itself */
+                AV* const isa_lin = newAV();
                 av_push(isa_lin, newSVsv(isa_item));
+                av_push(seqs, (SV*)isa_lin);
             }
             else {
-                isa_lin = (AV*)sv_2mortal((SV*)__mro_linear_isa_c3(aTHX_ isa_item_stash, cache, level + 1)); /* recursion */
+                /* recursion */
+                AV* const isa_lin = __mro_linear_isa_c3(aTHX_ isa_item_stash, cache, level + 1);
+                av_push(seqs, (SV*)isa_lin);
             }
-            av_push(seqs, (SV*)av_make(AvFILLp(isa_lin)+1, AvARRAY(isa_lin)));
         }
-        av_push(seqs, (SV*)av_make(AvFILLp(isa)+1, AvARRAY(isa)));
-
+        av_push(seqs, SvREFCNT_inc((SV*)isa));
+
+        /* This builds "heads", which as an array of integer array
+           indices, one per seq, which point at the virtual "head"
+           of the seq (initially zero) */
+        Newz(0xdead, heads, AvFILLp(seqs)+1, I32);
+
+        /* This builds %tails, which has one key for every class
+           mentioned in the tail of any sequence in @seqs (tail meaning
+           everything after the first class, the "head").  The value
+           is how many times this key appears in the tails of @seqs.
+        */
         seqs_ptr = AvARRAY(seqs);
         seqs_items = AvFILLp(seqs) + 1;
         while(seqs_items--) {
-            AV* seq = (AV*)*seqs_ptr++;
+            AV* const seq = (AV*)*seqs_ptr++;
             I32 seq_items = AvFILLp(seq);
             if(seq_items > 0) {
                 SV** seq_ptr = AvARRAY(seq) + 1;
                 while(seq_items--) {
-                    SV* seqitem = *seq_ptr++;
-                    HE* he = hv_fetch_ent(tails, seqitem, 0, 0);
+                    SV* const seqitem = *seq_ptr++;
+                    HE* const he = hv_fetch_ent(tails, seqitem, 0, 0);
                     if(!he) {
-                        hv_store_ent(tails, seqitem, newSViv(1), 0);
+                        if(!hv_store_ent(tails, seqitem, newSViv(1), 0)) {
+                            croak("failed to store value in hash");
+                        }
                     }
                     else {
-                        SV* val = HeVAL(he);
+                        SV* const val = HeVAL(he);
                         sv_inc(val);
                     }
                 }
             }
         }
 
+        /* Initialize retval to build the return value in */
+        retval = newAV();
+        av_push(retval, newSVpvn(stashname, stashname_len)); /* us first */
+
+        /* This loop won't terminate until we either finish building
+           the MRO, or get an exception. */
         while(1) {
-            SV* seqhead = NULL;
             SV* cand = NULL;
             SV* winner = NULL;
-            SV* val;
-            HE* tail_entry;
-            AV* seq;
-            SV** avptr = AvARRAY(seqs);
-            items = AvFILLp(seqs)+1;
-            while(items--) {
+            int s;
+
+            /* "foreach $seq (@seqs)" */
+            SV** const avptr = AvARRAY(seqs);
+            for(s = 0; s <= AvFILLp(seqs); s++) {
                 SV** svp;
-                seq = (AV*)*avptr++;
-                if(AvFILLp(seq) < 0) continue;
-                svp = av_fetch(seq, 0, 0);
-                seqhead = *svp;
+                AV * const seq = (AV*)(avptr[s]);
+                SV* seqhead;
+                if(!seq) continue; /* skip empty seqs */
+                svp = av_fetch(seq, heads[s], 0);
+                seqhead = *svp; /* seqhead = head of this seq */
                 if(!winner) {
+                    HE* tail_entry;
+                    SV* val;
+                    /* if we haven't found a winner for this round yet,
+                       and this seqhead is not in tails (or the count
+                       for it in tails has dropped to zero), then this
+                       seqhead is our new winner, and is added to the
+                       final MRO immediately */
                     cand = seqhead;
                     if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
                        && (val = HeVAL(tail_entry))
-                       && (SvIVx(val) > 0))
+                       && (SvIVX(val) > 0))
                            continue;
                     winner = newSVsv(cand);
                     av_push(retval, winner);
+                    /* note however that even when we find a winner,
+                       we continue looping over @seqs to do housekeeping */
                 }
                 if(!sv_cmp(seqhead, winner)) {
-                    sv_2mortal(av_shift(seq));
-                    if(AvFILLp(seq) < 0) continue;
-                    svp = av_fetch(seq, 0, 0);
-                    seqhead = *svp;
-                    tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
-                    val = HeVAL(tail_entry);
-                    sv_dec(val);
+                    /* Once we have a winner (including the iteration
+                       where we first found him), inc the head ptr
+                       for any seq which had the winner as a head,
+                       NULL out any seq which is now empty,
+                       and adjust tails for consistency */
+
+                    const int new_head = ++heads[s];
+                    if(new_head > AvFILLp(seq)) {
+                        SvREFCNT_dec(avptr[s]);
+                        avptr[s] = NULL;
+                    }
+                    else {
+                        HE* tail_entry;
+                        SV* val;
+                        /* Because we know this new seqhead used to be
+                           a tail, we can assume it is in tails and has
+                           a positive value, which we need to dec */
+                        svp = av_fetch(seq, new_head, 0);
+                        seqhead = *svp;
+                        tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
+                        val = HeVAL(tail_entry);
+                        sv_dec(val);
+                    }
+                }
+            }
+
+            /* if we found no candidates, we are done building the MRO.
+               !cand means no seqs have any entries left to check */
+            if(!cand) {
+                Safefree(heads);
+                break;
+            }
+
+            /* If we had candidates, but nobody won, then the @ISA
+               hierarchy is not C3-incompatible */
+            if(!winner) {
+                SV *errmsg;
+                I32 i;
+                /* we have to do some cleanup before we croak */
+
+                errmsg = newSVpvf("Inconsistent hierarchy during C3 merge of class '%s':\n\t"
+                                  "current merge results [\n", stashname);
+                for (i = 0; i <= av_len(retval); i++) {
+                    SV **elem = av_fetch(retval, i, 0);
+                    sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
                 }
+                sv_catpvf(errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
+
+                SvREFCNT_dec(retval);
+                Safefree(heads);
+
+                croak("%"SVf, SVfARG(errmsg));
             }
-            if(!cand) break;
-            if(!winner)
-                Perl_croak(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s': "
-                    "merging failed on parent '%s'", stashname, SvPV_nolen(cand));
         }
     }
+    else { /* @ISA was undefined or empty */
+        /* build a retval containing only ourselves */
+        retval = newAV();
+        av_push(retval, newSVpvn(stashname, stashname_len));
+    }
 
+    /* we don't want anyone modifying the cache entry but us,
+       and we do so by replacing it completely */
     SvREADONLY_on(retval);
-    SvREFCNT_inc(retval); /* for cache storage */
-    SvREFCNT_inc(retval); /* for return */
-    hv_store(cache, stashname, stashname_len, (SV*)retval, 0);
+
+    if(!made_mortal_cache) {
+        SvREFCNT_inc(retval);
+        if(!hv_store(cache, stashname, stashname_len, (SV*)retval, 0)) {
+            croak("failed to store value in hash");
+        }
+    }
+
     return retval;
 }
 
@@ -148,10 +283,14 @@ __dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
     return i;
 }
 
-STATIC SV*
-__nextcan(pTHX_ SV* self, I32 throw_nomethod)
+XS(XS_Class_C3_XS_nextcan);
+XS(XS_Class_C3_XS_nextcan)
 {
-    register I32 cxix;
+    dVAR; dXSARGS;
+
+    SV* self = ST(0);
+    const I32 throw_nomethod = SvIVX(ST(1));
+    register I32 cxix = cxstack_ix;
     register const PERL_CONTEXT *ccstack = cxstack;
     const PERL_SI *top_si = PL_curstackinfo;
     HV* selfstash;
@@ -166,15 +305,17 @@ __nextcan(pTHX_ SV* self, I32 throw_nomethod)
     GV** gvp;
     AV* linear_av;
     SV** linear_svp;
-    SV* linear_sv;
     HV* cstash;
     GV* candidate = NULL;
     CV* cand_cv = NULL;
     const char *hvname;
-    I32 items;
+    I32 entries;
     HV* nmcache;
     HE* cache_entry;
     SV* cachekey;
+    I32 i;
+
+    SP -= items;
 
     if(sv_isobject(self))
         selfstash = SvSTASH(SvRV(self));
@@ -185,65 +326,67 @@ __nextcan(pTHX_ SV* self, I32 throw_nomethod)
 
     hvname = HvNAME(selfstash);
     if (!hvname)
-        croak("Can't use anonymous symbol table for method lookup");
-
-    cxix = __dopoptosub_at(cxstack, cxstack_ix);
+        Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
 
     /* This block finds the contextually-enclosing fully-qualified subname,
        much like looking at (caller($i))[3] until you find a real sub that
-       isn't ANON, etc */
-    for (;;) {
-        /* we may be in a higher stacklevel, so dig down deeper */
-        while (cxix < 0) {
-            if(top_si->si_type == PERLSI_MAIN)
-                croak("next::method/next::can/maybe::next::method must be used in method context");
-            top_si = top_si->si_prev;
-            ccstack = top_si->si_cxstack;
-            cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
-        }
+       isn't ANON, etc (also skips over pureperl next::method, etc) */
+    for(i = 0; i < 2; i++) {
+        cxix = __dopoptosub_at(ccstack, cxix);
+        for (;;) {
+            /* we may be in a higher stacklevel, so dig down deeper */
+            while (cxix < 0) {
+                if(top_si->si_type == PERLSI_MAIN)
+                    Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
+                top_si = top_si->si_prev;
+                ccstack = top_si->si_cxstack;
+                cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
+            }
 
-        if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
-          || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
-            cxix = __dopoptosub_at(ccstack, cxix - 1);
-            continue;
-        }
+            if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
+              || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
+                cxix = __dopoptosub_at(ccstack, cxix - 1);
+                continue;
+            }
 
-        {
-            const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
-            if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
-                if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
-                    cxix = dbcxix;
-                    continue;
+            {
+                const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
+                if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
+                    if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
+                        cxix = dbcxix;
+                        continue;
+                    }
                 }
             }
-        }
 
-        cvgv = CvGV(ccstack[cxix].blk_sub.cv);
+            cvgv = CvGV(ccstack[cxix].blk_sub.cv);
 
-        if(!isGV(cvgv)) {
-            cxix = __dopoptosub_at(ccstack, cxix - 1);
-            continue;
-        }
+            if(!isGV(cvgv)) {
+                cxix = __dopoptosub_at(ccstack, cxix - 1);
+                continue;
+            }
 
-        /* we found a real sub here */
-        sv = sv_2mortal(newSV(0));
+            /* we found a real sub here */
+            sv = sv_2mortal(newSV(0));
 
-        gv_efullname3(sv, cvgv, NULL);
+            gv_efullname3(sv, cvgv, NULL);
 
-        fq_subname = SvPVX(sv);
-        fq_subname_len = SvCUR(sv);
+            fq_subname = SvPVX(sv);
+            fq_subname_len = SvCUR(sv);
 
-        subname = strrchr(fq_subname, ':');
-        if(!subname)
-            croak("next::method/next::can/maybe::next::method cannot find enclosing method");
+            subname = strrchr(fq_subname, ':');
+            if(!subname)
+                Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
 
-        subname++;
-        subname_len = fq_subname_len - (subname - fq_subname);
-        if(subname_len == 8 && strEQ(subname, "__ANON__")) {
-            cxix = __dopoptosub_at(ccstack, cxix - 1);
-            continue;
+            subname++;
+            subname_len = fq_subname_len - (subname - fq_subname);
+            if(subname_len == 8 && strEQ(subname, "__ANON__")) {
+                cxix = __dopoptosub_at(ccstack, cxix - 1);
+                continue;
+            }
+            break;
         }
-        break;
+        cxix--;
     }
 
     /* If we made it to here, we found our context */
@@ -258,10 +401,11 @@ __nextcan(pTHX_ SV* self, I32 throw_nomethod)
         SV* val = HeVAL(cache_entry);
         if(val == &PL_sv_undef) {
             if(throw_nomethod)
-                croak("No next::method '%s' found for %s", subname, hvname);
-            return &PL_sv_undef;
+                Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
+            XSRETURN_EMPTY;
         }
-        return SvREFCNT_inc(val);
+        XPUSHs(sv_2mortal(newRV_inc(val)));
+        XSRETURN(1);
     }
 
     /* beyond here is just for cache misses, so perf isn't as critical */
@@ -269,35 +413,41 @@ __nextcan(pTHX_ SV* self, I32 throw_nomethod)
     stashname_len = subname - fq_subname - 2;
     stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len));
 
-    linear_av = (AV*)sv_2mortal((SV*)__mro_linear_isa_c3(aTHX_ selfstash, NULL, 0));
+    linear_av = __mro_linear_isa_c3(aTHX_ selfstash, NULL, 0);
 
     linear_svp = AvARRAY(linear_av);
-    items = AvFILLp(linear_av) + 1;
+    entries = AvFILLp(linear_av) + 1;
 
-    while (items--) {
-        linear_sv = *linear_svp++;
+    while (entries--) {
+        SV* const linear_sv = *linear_svp++;
         assert(linear_sv);
         if(sv_eq(linear_sv, stashname))
             break;
     }
 
-    if(items > 0) {
+    if(entries > 0) {
         SV* sub_sv = sv_2mortal(newSVpv(subname, subname_len));
         HV* cc3_mro = get_hv("Class::C3::MRO", 0);
 
-        while (items--) {
-            linear_sv = *linear_svp++;
+        while (entries--) {
+            SV* const linear_sv = *linear_svp++;
             assert(linear_sv);
 
             if(cc3_mro) {
                 HE* he_cc3_mro_class = hv_fetch_ent(cc3_mro, linear_sv, 0, 0);
                 if(he_cc3_mro_class) {
-                    HV* cc3_mro_class = (HV*)SvRV(HeVAL(he_cc3_mro_class));
-                    SV** svp_cc3_mro_class_methods = hv_fetch(cc3_mro_class, "methods", 7, 0);
-                    if(svp_cc3_mro_class_methods) {
-                        HV* cc3_mro_class_methods = (HV*)SvRV(*svp_cc3_mro_class_methods);
-                        if(hv_exists_ent(cc3_mro_class_methods, sub_sv, 0))
-                            continue;
+                    SV* cc3_mro_class_sv = HeVAL(he_cc3_mro_class);
+                    if(SvROK(cc3_mro_class_sv)) {
+                        HV* cc3_mro_class = (HV*)SvRV(cc3_mro_class_sv);
+                        SV** svp_cc3_mro_class_methods = hv_fetch(cc3_mro_class, "methods", 7, 0);
+                        if(svp_cc3_mro_class_methods) {
+                            SV* cc3_mro_class_methods_sv = *svp_cc3_mro_class_methods;
+                            if(SvROK(cc3_mro_class_methods_sv)) {
+                                HV* cc3_mro_class_methods = (HV*)SvRV(cc3_mro_class_methods_sv);
+                                if(hv_exists_ent(cc3_mro_class_methods, sub_sv, 0))
+                                    continue;
+                            }
+                        }
                     }
                 }
             }
@@ -322,27 +472,30 @@ __nextcan(pTHX_ SV* self, I32 throw_nomethod)
             if (SvTYPE(candidate) != SVt_PVGV)
                 gv_init(candidate, cstash, subname, subname_len, TRUE);
             if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
+                SvREFCNT_dec(linear_av);
                 SvREFCNT_inc((SV*)cand_cv);
-                hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0);
-                return (SV*)cand_cv;
+                if (!hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0)) {
+                    croak("failed to store value in hash");
+                }
+                XPUSHs(sv_2mortal(newRV_inc((SV*)cand_cv)));
+                XSRETURN(1);
             }
         }
     }
 
-    hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0);
+    SvREFCNT_dec(linear_av);
+    if (!hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0)) {
+        croak("failed to store value in hash");
+    }
     if(throw_nomethod)
-        croak("No next::method '%s' found for %s", subname, hvname);
-    return &PL_sv_undef;
+        Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
+    XSRETURN_EMPTY;
 }
 
 XS(XS_Class_C3_XS_calculateMRO);
 XS(XS_Class_C3_XS_calculateMRO)
 {
-#ifdef dVAR
     dVAR; dXSARGS;
-#else
-    dXSARGS;
-#endif
 
     SV* classname;
     HV* class_stash;
@@ -359,9 +512,10 @@ XS(XS_Class_C3_XS_calculateMRO)
     if(items == 2) cache = (HV*)SvRV(ST(1));
 
     class_stash = gv_stashsv(classname, 0);
-    if(!class_stash) croak("No such class: '%s'!", SvPV_nolen(classname));
+    if(!class_stash)
+        Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));
 
-    res = (AV*)sv_2mortal((SV*)__mro_linear_isa_c3(aTHX_ class_stash, cache, 0));
+    res = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
 
     res_items = ret_items = AvFILLp(res) + 1;
     res_ptr = AvARRAY(res);
@@ -370,71 +524,135 @@ XS(XS_Class_C3_XS_calculateMRO)
 
     while(res_items--) {
         SV* res_item = *res_ptr++;
-        XPUSHs(res_item);
+        XPUSHs(sv_2mortal(newSVsv(res_item)));
     }
+    SvREFCNT_dec(res);
 
     PUTBACK;
 
     return;
 }
 
-XS(XS_next_can);
-XS(XS_next_can)
+XS(XS_Class_C3_XS_plsubgen);
+XS(XS_Class_C3_XS_plsubgen)
 {
-#ifdef dVAR
     dVAR; dXSARGS;
-#else
-    dXSARGS;
-#endif
 
-    SV* self = ST(0);
-    SV* methcv = __nextcan(aTHX_ self, 0);
+    SP -= items;
+    XPUSHs(sv_2mortal(newSViv(PL_sub_generation)));
+    PUTBACK;
+    return;
+}
+
+XS(XS_Class_C3_XS_calc_mdt);
+XS(XS_Class_C3_XS_calc_mdt)
+{
+    dVAR; dXSARGS;
+
+    SV* classname;
+    HV* cache;
+    HV* class_stash;
+    AV* class_mro;
+    HV* our_c3mro; /* $Class::C3::MRO{classname} */
+    SV* has_ovf = NULL;
+    HV* methods;
+    I32 mroitems;
 
-    PERL_UNUSED_VAR(items);
+    /* temps */
+    HV* hv;
+    HE* he;
+    SV** svp;
 
-    if(methcv == &PL_sv_undef) {
-        ST(0) = &PL_sv_undef;
+    if(items < 1 || items > 2)
+        croak("Usage: calculate_method_dispatch_table(classname[, cache])");
+
+    classname = ST(0);
+    class_stash = gv_stashsv(classname, 0);
+    if(!class_stash)
+        Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));
+
+    if(items == 2) cache = (HV*)SvRV(ST(1));
+
+    class_mro = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
+
+    our_c3mro = newHV();
+    if(!hv_store(our_c3mro, "MRO", 3, (SV*)newRV_noinc((SV*)class_mro), 0)) {
+        croak("failed to store value in hash");
     }
-    else {
-        ST(0) = sv_2mortal(newRV_inc(methcv));
+
+    hv = get_hv("Class::C3::MRO", 1);
+    if(!hv_store_ent(hv, classname, (SV*)newRV_noinc((SV*)our_c3mro), 0)) {
+        croak("failed to store value in hash");
     }
 
-    XSRETURN(1);
-}
+    methods = newHV();
 
-XS(XS_next_method);
-XS(XS_next_method)
-{
-    dMARK;
-    dAX;
-    SV* self = ST(0);
-    SV* methcv = __nextcan(aTHX_ self, 1);
+    /* skip first entry */
+    mroitems = AvFILLp(class_mro);
+    svp = AvARRAY(class_mro) + 1;
+    while(mroitems--) {
+        SV* mro_class = *svp++;
+        HV* mro_stash = gv_stashsv(mro_class, 0);
 
-    PL_markstack_ptr++;
-    call_sv(methcv, GIMME_V);
-}
+        if(!mro_stash) continue;
 
-XS(XS_maybe_next_method);
-XS(XS_maybe_next_method)
-{
-    dMARK;
-    dAX;
-    SV* self = ST(0);
-    SV* methcv = __nextcan(aTHX_ self, 0);
+        if(!has_ovf) {
+            SV** ovfp = hv_fetch(mro_stash, "()", 2, 0);
+            if(ovfp) has_ovf = *ovfp;
+        }
 
-    if(methcv == &PL_sv_undef) {
-        ST(0) = &PL_sv_undef;
-        XSRETURN(1);
+        hv_iterinit(mro_stash);
+        while((he = hv_iternext(mro_stash))) {
+            CV* code;
+            SV* mskey;
+            SV* msval;
+            HE* ourent;
+            HV* meth_hash;
+            SV* orig;
+
+            mskey = hv_iterkeysv(he);
+            if(hv_exists_ent(methods, mskey, 0)) continue;
+
+            msval = hv_iterval(mro_stash, he);
+            if(SvTYPE(msval) != SVt_PVGV || !(code = GvCVu(msval)))
+                continue;
+
+            if((ourent = hv_fetch_ent(class_stash, mskey, 0, 0))) {
+                SV* val = HeVAL(ourent);
+                if(val && SvTYPE(val) == SVt_PVGV && GvCVu(val))
+                    continue;
+            }
+
+            meth_hash = newHV();
+            orig = newSVsv(mro_class);
+            sv_catpvn(orig, "::", 2);
+            sv_catsv(orig, mskey);
+            if( !hv_store(meth_hash, "orig", 4, orig, 0)
+             || !hv_store(meth_hash, "code", 4, newRV_inc((SV*)code), 0)
+             || !hv_store_ent(methods, mskey, newRV_noinc((SV*)meth_hash), 0) ) {
+                croak("failed to store value in hash");
+            }
+        }
     }
 
-    PL_markstack_ptr++;
-    call_sv(methcv, GIMME_V);
+    if(!hv_store(our_c3mro, "methods", 7, newRV_noinc((SV*)methods), 0)) {
+        croak("failed to store value in hash");
+    }
+    if(has_ovf) {
+        if(!hv_store(our_c3mro, "has_overload_fallback", 21, SvREFCNT_inc(has_ovf), 0)) {
+            croak("failed to store value in hash");
+        }
+    }
+    XSRETURN_EMPTY;
 }
 
-MODULE = Class::C3::XS	PACKAGE = Class::C3::XS
+MODULE = Class::C3::XS  PACKAGE = Class::C3::XS
+
+PROTOTYPES: DISABLED
 
 BOOT:
     newXS("Class::C3::XS::calculateMRO", XS_Class_C3_XS_calculateMRO, __FILE__);
-    newXS("next::can", XS_next_can, __FILE__);
-    newXS("next::method", XS_next_method, __FILE__);
-    newXS("maybe::next::method", XS_maybe_next_method, __FILE__);
+    newXS("Class::C3::XS::_plsubgen", XS_Class_C3_XS_plsubgen, __FILE__);
+    newXS("Class::C3::XS::_calculate_method_dispatch_table", XS_Class_C3_XS_calc_mdt, __FILE__);
+    newXS("Class::C3::XS::_nextcan", XS_Class_C3_XS_nextcan, __FILE__);
+