[gitmo/Class-C3-XS.git] / XS.xs


#include "EXTERN.h"
#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.
*/

AV*
__mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
{
    AV* retval;
    GV** gvp;
    GV* gv;
    AV* isa;
    const char* stashname;
    STRLEN stashname_len;
    I32 made_mortal_cache = 0;

    assert(stash);

    stashname = HvNAME(stash);
    stashname_len = strlen(stashname);
    if (!stashname)
      Perl_croak(aTHX_
                 "Can't linearize anonymous symbol table");

    if (level > 100)
        Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
              stashname);

    if(!cache) {
        cache = (HV*)sv_2mortal((SV*)newHV());
        made_mortal_cache = 1;
    }
    else {
        SV** cache_entry = hv_fetch(cache, stashname, stashname_len, 0);
        if(cache_entry)
            return (AV*)SvREFCNT_inc(*cache_entry);
    }

    /* not in cache, make a new one */

    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* 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--) {
            SV* const isa_item = *isa_ptr++;
            HV* const isa_item_stash = gv_stashsv(isa_item, 0);
            if(!isa_item_stash) {
                /* 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 {
                /* 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, 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* const seq = (AV*)*seqs_ptr++;
            I32 seq_items = AvFILLp(seq);
            if(seq_items > 0) {
                SV** seq_ptr = AvARRAY(seq) + 1;
                while(seq_items--) {
                    SV* const seqitem = *seq_ptr++;
                    HE* const he = hv_fetch_ent(tails, seqitem, 0, 0);
                    if(!he) {
                        if(!hv_store_ent(tails, seqitem, newSViv(1), 0)) {
                            croak("failed to store value in hash");
                        }
                    }
                    else {
                        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* cand = NULL;
            SV* winner = NULL;
            int s;

            /* "foreach $seq (@seqs)" */
            SV** const avptr = AvARRAY(seqs);
            for(s = 0; s <= AvFILLp(seqs); s++) {
                SV** 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))
                           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)) {
                    /* 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));
            }
        }
    }
    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);

    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;
}

STATIC I32
__dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
    I32 i;
    for (i = startingblock; i >= 0; i--) {
        if(CxTYPE((PERL_CONTEXT*)(&cxstk[i])) == CXt_SUB) return i;
    }
    return i;
}

XS(XS_Class_C3_XS_nextcan);
XS(XS_Class_C3_XS_nextcan)
{
    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;
    GV* cvgv;
    SV *stashname;
    const char *fq_subname;
    const char *subname;
    STRLEN fq_subname_len;
    STRLEN stashname_len;
    STRLEN subname_len;
    SV* sv;
    GV** gvp;
    AV* linear_av;
    SV** linear_svp;
    HV* cstash;
    GV* candidate = NULL;
    CV* cand_cv = NULL;
    const char *hvname;
    I32 entries;
    HV* nmcache;
    HE* cache_entry;
    SV* cachekey;
    I32 i;

    SP -= items;

    if(sv_isobject(self))
        selfstash = SvSTASH(SvRV(self));
    else
        selfstash = gv_stashsv(self, 0);

    assert(selfstash);

    hvname = HvNAME(selfstash);
    if (!hvname)
        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 (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;
            }

            {
                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);

            if(!isGV(cvgv)) {
                cxix = __dopoptosub_at(ccstack, cxix - 1);
                continue;
            }

            /* we found a real sub here */
            sv = sv_2mortal(newSV(0));

            gv_efullname3(sv, cvgv, NULL);

            fq_subname = SvPVX(sv);
            fq_subname_len = SvCUR(sv);

            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;
            }
            break;
        }
        cxix--;
    }

    /* If we made it to here, we found our context */

    /* cachekey = "objpkg|context::method::name" */
    cachekey = sv_2mortal(newSVpv(hvname, 0));
    sv_catpvn(cachekey, "|", 1);
    sv_catsv(cachekey, sv);

    nmcache = get_hv("next::METHOD_CACHE", 1);
    if((cache_entry = hv_fetch_ent(nmcache, cachekey, 0, 0))) {
        SV* val = HeVAL(cache_entry);
        if(val == &PL_sv_undef) {
            if(throw_nomethod)
                Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
            XSRETURN_EMPTY;
        }
        XPUSHs(sv_2mortal(newRV_inc(val)));
        XSRETURN(1);
    }

    /* beyond here is just for cache misses, so perf isn't as critical */

    stashname_len = subname - fq_subname - 2;
    stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len));

    linear_av = __mro_linear_isa_c3(aTHX_ selfstash, NULL, 0);

    linear_svp = AvARRAY(linear_av);
    entries = AvFILLp(linear_av) + 1;

    while (entries--) {
        SV* const linear_sv = *linear_svp++;
        assert(linear_sv);
        if(sv_eq(linear_sv, stashname))
            break;
    }

    if(entries > 0) {
        SV* sub_sv = sv_2mortal(newSVpv(subname, subname_len));
        HV* cc3_mro = get_hv("Class::C3::MRO", 0);

        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) {
                    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;
                            }
                        }
                    }
                }
            }

            cstash = gv_stashsv(linear_sv, FALSE);

            if (!cstash) {
                if (ckWARN(WARN_MISC))
                    Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
                        (void*)linear_sv, hvname);
                continue;
            }

            assert(cstash);

            gvp = (GV**)hv_fetch(cstash, subname, subname_len, 0);
            if (!gvp) continue;

            candidate = *gvp;
            assert(candidate);

            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);
                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);
            }
        }
    }

    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)
        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)
{
    dVAR; dXSARGS;

    SV* classname;
    HV* class_stash;
    HV* cache = NULL;
    AV* res;
    I32 res_items;
    I32 ret_items;
    SV** res_ptr;

    if(items < 1 || items > 2)
        croak("Usage: calculateMRO(classname[, cache])");

    classname = ST(0);
    if(items == 2) cache = (HV*)SvRV(ST(1));

    class_stash = gv_stashsv(classname, 0);
    if(!class_stash)
        Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));

    res = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);

    res_items = ret_items = AvFILLp(res) + 1;
    res_ptr = AvARRAY(res);

    SP -= items;

    while(res_items--) {
        SV* res_item = *res_ptr++;
        XPUSHs(sv_2mortal(newSVsv(res_item)));
    }
    SvREFCNT_dec(res);

    PUTBACK;

    return;
}

XS(XS_Class_C3_XS_plsubgen);
XS(XS_Class_C3_XS_plsubgen)
{
    dVAR; dXSARGS;

    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;

    /* temps */
    HV* hv;
    HE* he;
    SV** svp;

    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");
    }

    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");
    }

    methods = newHV();

    /* 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);

        if(!mro_stash) continue;

        if(!has_ovf) {
            SV** ovfp = hv_fetch(mro_stash, "()", 2, 0);
            if(ovfp) has_ovf = *ovfp;
        }

        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");
            }
        }
    }

    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

PROTOTYPES: DISABLED

BOOT:
    newXS("Class::C3::XS::calculateMRO", XS_Class_C3_XS_calculateMRO, __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__);
Commit	Line	Data
8995e827	1
	2	#include "EXTERN.h"
	3	#include "perl.h"
	4	#include "XSUB.h"
8995e827	5
25dc7e96	6	/* *********** ppport stuff */
	7
	8	#ifndef PERL_UNUSED_VAR
	9	# define PERL_UNUSED_VAR(x) ((void)x)
	10	#endif
	11
	12	#if defined(PERL_GCC_PEDANTIC)
	13	# ifndef PERL_GCC_BRACE_GROUPS_FORBIDDEN
	14	# define PERL_GCC_BRACE_GROUPS_FORBIDDEN
	15	# endif
	16	#endif
	17
	18	#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) && !defined(__cplusplus)
	19	# ifndef PERL_USE_GCC_BRACE_GROUPS
	20	# define PERL_USE_GCC_BRACE_GROUPS
	21	# endif
	22	#endif
	23
	24	#ifndef SvREFCNT_inc
	25	# ifdef PERL_USE_GCC_BRACE_GROUPS
6ed110b7	26	# define SvREFCNT_inc(sv) \
	27	({ \
	28	SV * const _sv = (SV*)(sv); \
	29	if (_sv) \
	30	(SvREFCNT(_sv))++; \
	31	_sv; \
25dc7e96	32	})
25dc7e96	33	# else
6ed110b7	34	# define SvREFCNT_inc(sv) \
25dc7e96	35	((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
	36	# endif
	37	#endif
	38
	39	#ifndef dAX
	40	# define dAX I32 ax = MARK - PL_stack_base + 1
	41	#endif
	42
	43	#ifndef dVAR
	44	# define dVAR dNOOP
	45	#endif
	46
	47	#ifndef packWARN
	48	# define packWARN(a) (a)
	49	#endif
	50
	51	/* *********** end ppport.h stuff */
	52
68fe9f29	53	#ifndef SVfARG
	54	# define SVfARG(p) ((void*)(p))
	55	#endif
	56
29e61e10	57	/* Most of this code is backported from the bleadperl patch's
b23e9cb9	58	mro.c, and then modified to work with Class::C3's
	59	internals.
	60	*/
8995e827	61
b23e9cb9	62	AV*
	63	__mro_linear_isa_c3(pTHX_ HV* stash, HV* cache, I32 level)
	64	{
	65	AV* retval;
	66	GV** gvp;
	67	GV* gv;
	68	AV* isa;
	69	const char* stashname;
	70	STRLEN stashname_len;
bb82f0c1	71	I32 made_mortal_cache = 0;
8995e827	72
b23e9cb9	73	assert(stash);
8995e827	74
b23e9cb9	75	stashname = HvNAME(stash);
	76	stashname_len = strlen(stashname);
	77	if (!stashname)
	78	Perl_croak(aTHX_
	79	"Can't linearize anonymous symbol table");
8995e827	80
b23e9cb9	81	if (level > 100)
	82	Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
	83	stashname);
8995e827	84
b23e9cb9	85	if(!cache) {
f0294f1b	86	cache = (HV)sv_2mortal((SV)newHV());
bb82f0c1	87	made_mortal_cache = 1;
b23e9cb9	88	}
b23e9cb9	89	else {
6bf46d18	90	SV** cache_entry = hv_fetch(cache, stashname, stashname_len, 0);
	91	if(cache_entry)
	92	return (AV)SvREFCNT_inc(cache_entry);
b23e9cb9	93	}
	94
	95	/* not in cache, make a new one */
	96
b23e9cb9	97	gvp = (GV**)hv_fetch(stash, "ISA", 3, FALSE);
b23e9cb9	98	isa = (gvp && (gv = gvp) && gv != (GV)&PL_sv_undef) ? GvAV(gv) : NULL;
b23e9cb9	99	if(isa && AvFILLp(isa) >= 0) {
	100	SV** seqs_ptr;
	101	I32 seqs_items;
bb82f0c1	102	HV* const tails = (HV)sv_2mortal((SV)newHV());
	103	AV* const seqs = (AV)sv_2mortal((SV)newAV());
	104	I32* heads;
	105
053556af	106	/* This builds @seqs, which is an array of arrays.
	107	The members of @seqs are the MROs of
	108	the members of @ISA, followed by @ISA itself.
	109	*/
b23e9cb9	110	I32 items = AvFILLp(isa) + 1;
	111	SV** isa_ptr = AvARRAY(isa);
	112	while(items--) {
bb82f0c1	113	SV* const isa_item = *isa_ptr++;
bb82f0c1	114	HV* const isa_item_stash = gv_stashsv(isa_item, 0);
b23e9cb9	115	if(!isa_item_stash) {
053556af	116	/* if no stash, make a temporary fake MRO
053556af	117	containing just itself */
bb82f0c1	118	AV* const isa_lin = newAV();
b23e9cb9	119	av_push(isa_lin, newSVsv(isa_item));
bb82f0c1	120	av_push(seqs, (SV*)isa_lin);
b23e9cb9	121	}
b23e9cb9	122	else {
053556af	123	/* recursion */
053556af	124	AV* const isa_lin = __mro_linear_isa_c3(aTHX_ isa_item_stash, cache, level + 1);
bb82f0c1	125	av_push(seqs, (SV*)isa_lin);
b23e9cb9	126	}
b23e9cb9	127	}
bb82f0c1	128	av_push(seqs, SvREFCNT_inc((SV*)isa));
	129
	130	/* This builds "heads", which as an array of integer array
	131	indices, one per seq, which point at the virtual "head"
	132	of the seq (initially zero) */
bb82f0c1	133	Newz(0xdead, heads, AvFILLp(seqs)+1, I32);
b23e9cb9	134
bb82f0c1	135	/* This builds %tails, which has one key for every class
	136	mentioned in the tail of any sequence in @seqs (tail meaning
	137	everything after the first class, the "head"). The value
	138	is how many times this key appears in the tails of @seqs.
	139	*/
b23e9cb9	140	seqs_ptr = AvARRAY(seqs);
	141	seqs_items = AvFILLp(seqs) + 1;
	142	while(seqs_items--) {
bb82f0c1	143	AV* const seq = (AV)seqs_ptr++;
b23e9cb9	144	I32 seq_items = AvFILLp(seq);
	145	if(seq_items > 0) {
	146	SV** seq_ptr = AvARRAY(seq) + 1;
	147	while(seq_items--) {
bb82f0c1	148	SV* const seqitem = *seq_ptr++;
bb82f0c1	149	HE* const he = hv_fetch_ent(tails, seqitem, 0, 0);
b23e9cb9	150	if(!he) {
ddc85d9f	151	if(!hv_store_ent(tails, seqitem, newSViv(1), 0)) {
	152	croak("failed to store value in hash");
	153	}
b23e9cb9	154	}
b23e9cb9	155	else {
bb82f0c1	156	SV* const val = HeVAL(he);
b23e9cb9	157	sv_inc(val);
	158	}
	159	}
	160	}
	161	}
	162
bb82f0c1	163	/* Initialize retval to build the return value in */
	164	retval = newAV();
	165	av_push(retval, newSVpvn(stashname, stashname_len)); /* us first */
	166
053556af	167	/* This loop won't terminate until we either finish building
053556af	168	the MRO, or get an exception. */
b23e9cb9	169	while(1) {
b23e9cb9	170	SV* cand = NULL;
b23e9cb9	171	SV* winner = NULL;
bb82f0c1	172	int s;
bb82f0c1	173
053556af	174	/* "foreach $seq (@seqs)" */
bb82f0c1	175	SV** const avptr = AvARRAY(seqs);
bb82f0c1	176	for(s = 0; s <= AvFILLp(seqs); s++) {
b23e9cb9	177	SV** svp;
bb82f0c1	178	AV * const seq = (AV*)(avptr[s]);
bb82f0c1	179	SV* seqhead;
053556af	180	if(!seq) continue; /* skip empty seqs */
bb82f0c1	181	svp = av_fetch(seq, heads[s], 0);
053556af	182	seqhead = svp; / seqhead = head of this seq */
b23e9cb9	183	if(!winner) {
bb82f0c1	184	HE* tail_entry;
bb82f0c1	185	SV* val;
053556af	186	/* if we haven't found a winner for this round yet,
	187	and this seqhead is not in tails (or the count
	188	for it in tails has dropped to zero), then this
	189	seqhead is our new winner, and is added to the
	190	final MRO immediately */
b23e9cb9	191	cand = seqhead;
	192	if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
	193	&& (val = HeVAL(tail_entry))
053556af	194	&& (SvIVX(val) > 0))
b23e9cb9	195	continue;
	196	winner = newSVsv(cand);
	197	av_push(retval, winner);
053556af	198	/* note however that even when we find a winner,
053556af	199	we continue looping over @seqs to do housekeeping */
b23e9cb9	200	}
b23e9cb9	201	if(!sv_cmp(seqhead, winner)) {
053556af	202	/* Once we have a winner (including the iteration
	203	where we first found him), inc the head ptr
	204	for any seq which had the winner as a head,
	205	NULL out any seq which is now empty,
	206	and adjust tails for consistency */
	207
bb82f0c1	208	const int new_head = ++heads[s];
	209	if(new_head > AvFILLp(seq)) {
	210	SvREFCNT_dec(avptr[s]);
	211	avptr[s] = NULL;
	212	}
	213	else {
	214	HE* tail_entry;
	215	SV* val;
	216	/* Because we know this new seqhead used to be
	217	a tail, we can assume it is in tails and has
	218	a positive value, which we need to dec */
	219	svp = av_fetch(seq, new_head, 0);
	220	seqhead = *svp;
	221	tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
	222	val = HeVAL(tail_entry);
	223	sv_dec(val);
	224	}
b23e9cb9	225	}
b23e9cb9	226	}
053556af	227
	228	/* if we found no candidates, we are done building the MRO.
	229	!cand means no seqs have any entries left to check */
bb82f0c1	230	if(!cand) {
	231	Safefree(heads);
	232	break;
	233	}
053556af	234
	235	/* If we had candidates, but nobody won, then the @ISA
	236	hierarchy is not C3-incompatible */
62eb9d08	237	if(!winner) {
b6bdbb4c	238	SV *errmsg;
b6bdbb4c	239	I32 i;
053556af	240	/* we have to do some cleanup before we croak */
053556af	241
b6bdbb4c	242	errmsg = newSVpvf("Inconsistent hierarchy during C3 merge of class '%s':\n\t"
	243	"current merge results [\n", stashname);
	244	for (i = 0; i <= av_len(retval); i++) {
	245	SV **elem = av_fetch(retval, i, 0);
	246	sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
	247	}
	248	sv_catpvf(errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
	249
62eb9d08	250	SvREFCNT_dec(retval);
bb82f0c1	251	Safefree(heads);
053556af	252
b6bdbb4c	253	croak("%"SVf, SVfARG(errmsg));
62eb9d08	254	}
b23e9cb9	255	}
b23e9cb9	256	}
053556af	257	else { /* @ISA was undefined or empty */
053556af	258	/* build a retval containing only ourselves */
bb82f0c1	259	retval = newAV();
053556af	260	av_push(retval, newSVpvn(stashname, stashname_len));
bb82f0c1	261	}
b23e9cb9	262
053556af	263	/* we don't want anyone modifying the cache entry but us,
053556af	264	and we do so by replacing it completely */
b23e9cb9	265	SvREADONLY_on(retval);
bb82f0c1	266
	267	if(!made_mortal_cache) {
	268	SvREFCNT_inc(retval);
ddc85d9f	269	if(!hv_store(cache, stashname, stashname_len, (SV*)retval, 0)) {
	270	croak("failed to store value in hash");
	271	}
bb82f0c1	272	}
	273
	274	return retval;
b23e9cb9	275	}
	276
	277	STATIC I32
	278	__dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
	279	I32 i;
	280	for (i = startingblock; i >= 0; i--) {
	281	if(CxTYPE((PERL_CONTEXT*)(&cxstk[i])) == CXt_SUB) return i;
	282	}
	283	return i;
	284	}
	285
2605e591	286	XS(XS_Class_C3_XS_nextcan);
2605e591	287	XS(XS_Class_C3_XS_nextcan)
b23e9cb9	288	{
2605e591	289	dVAR; dXSARGS;
2605e591	290
e5e121c4	291	SV* self = ST(0);
e5e121c4	292	const I32 throw_nomethod = SvIVX(ST(1));
5efa8a5b	293	register I32 cxix = cxstack_ix;
b23e9cb9	294	register const PERL_CONTEXT *ccstack = cxstack;
	295	const PERL_SI *top_si = PL_curstackinfo;
	296	HV* selfstash;
	297	GV* cvgv;
	298	SV *stashname;
	299	const char *fq_subname;
	300	const char *subname;
	301	STRLEN fq_subname_len;
	302	STRLEN stashname_len;
	303	STRLEN subname_len;
	304	SV* sv;
	305	GV** gvp;
	306	AV* linear_av;
	307	SV** linear_svp;
b23e9cb9	308	HV* cstash;
	309	GV* candidate = NULL;
	310	CV* cand_cv = NULL;
	311	const char *hvname;
2605e591	312	I32 entries;
6c88cc6a	313	HV* nmcache;
b23e9cb9	314	HE* cache_entry;
22c6f594	315	SV* cachekey;
54d13ec6	316	I32 i;
b23e9cb9	317
2605e591	318	SP -= items;
2605e591	319
b23e9cb9	320	if(sv_isobject(self))
	321	selfstash = SvSTASH(SvRV(self));
	322	else
	323	selfstash = gv_stashsv(self, 0);
	324
	325	assert(selfstash);
	326
	327	hvname = HvNAME(selfstash);
	328	if (!hvname)
625e16df	329	Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
b23e9cb9	330
b23e9cb9	331	/* This block finds the contextually-enclosing fully-qualified subname,
b23e9cb9	332	much like looking at (caller($i))[3] until you find a real sub that
5efa8a5b	333	isn't ANON, etc (also skips over pureperl next::method, etc) */
	334	for(i = 0; i < 2; i++) {
	335	cxix = __dopoptosub_at(ccstack, cxix);
	336	for (;;) {
	337	/* we may be in a higher stacklevel, so dig down deeper */
	338	while (cxix < 0) {
	339	if(top_si->si_type == PERLSI_MAIN)
	340	Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
	341	top_si = top_si->si_prev;
	342	ccstack = top_si->si_cxstack;
	343	cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
	344	}
b23e9cb9	345
5efa8a5b	346	if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
	347	\|\| (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
	348	cxix = __dopoptosub_at(ccstack, cxix - 1);
	349	continue;
	350	}
b23e9cb9	351
5efa8a5b	352	{
	353	const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
	354	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
	355	if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
	356	cxix = dbcxix;
	357	continue;
	358	}
b23e9cb9	359	}
b23e9cb9	360	}
b23e9cb9	361
5efa8a5b	362	cvgv = CvGV(ccstack[cxix].blk_sub.cv);
b23e9cb9	363
5efa8a5b	364	if(!isGV(cvgv)) {
	365	cxix = __dopoptosub_at(ccstack, cxix - 1);
	366	continue;
	367	}
b23e9cb9	368
5efa8a5b	369	/* we found a real sub here */
5efa8a5b	370	sv = sv_2mortal(newSV(0));
b23e9cb9	371
5efa8a5b	372	gv_efullname3(sv, cvgv, NULL);
b23e9cb9	373
5efa8a5b	374	fq_subname = SvPVX(sv);
5efa8a5b	375	fq_subname_len = SvCUR(sv);
b23e9cb9	376
5efa8a5b	377	subname = strrchr(fq_subname, ':');
	378	if(!subname)
	379	Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
b23e9cb9	380
5efa8a5b	381	subname++;
	382	subname_len = fq_subname_len - (subname - fq_subname);
	383	if(subname_len == 8 && strEQ(subname, "__ANON__")) {
	384	cxix = __dopoptosub_at(ccstack, cxix - 1);
	385	continue;
	386	}
	387	break;
b23e9cb9	388	}
5efa8a5b	389	cxix--;
b23e9cb9	390	}
	391
	392	/* If we made it to here, we found our context */
	393
22c6f594	394	/* cachekey = "objpkg\|context::method::name" */
	395	cachekey = sv_2mortal(newSVpv(hvname, 0));
	396	sv_catpvn(cachekey, "\|", 1);
	397	sv_catsv(cachekey, sv);
b23e9cb9	398
6c88cc6a	399	nmcache = get_hv("next::METHOD_CACHE", 1);
22c6f594	400	if((cache_entry = hv_fetch_ent(nmcache, cachekey, 0, 0))) {
b23e9cb9	401	SV* val = HeVAL(cache_entry);
	402	if(val == &PL_sv_undef) {
	403	if(throw_nomethod)
625e16df	404	Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
2605e591	405	XSRETURN_EMPTY;
b23e9cb9	406	}
2605e591	407	XPUSHs(sv_2mortal(newRV_inc(val)));
2605e591	408	XSRETURN(1);
b23e9cb9	409	}
b23e9cb9	410
	411	/* beyond here is just for cache misses, so perf isn't as critical */
	412
	413	stashname_len = subname - fq_subname - 2;
	414	stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len));
	415
62eb9d08	416	linear_av = __mro_linear_isa_c3(aTHX_ selfstash, NULL, 0);
b23e9cb9	417
b23e9cb9	418	linear_svp = AvARRAY(linear_av);
2605e591	419	entries = AvFILLp(linear_av) + 1;
b23e9cb9	420
2605e591	421	while (entries--) {
053556af	422	SV* const linear_sv = *linear_svp++;
b23e9cb9	423	assert(linear_sv);
	424	if(sv_eq(linear_sv, stashname))
	425	break;
	426	}
	427
2605e591	428	if(entries > 0) {
29e61e10	429	SV* sub_sv = sv_2mortal(newSVpv(subname, subname_len));
29e61e10	430	HV* cc3_mro = get_hv("Class::C3::MRO", 0);
29e61e10	431
2605e591	432	while (entries--) {
053556af	433	SV* const linear_sv = *linear_svp++;
b23e9cb9	434	assert(linear_sv);
29e61e10	435
	436	if(cc3_mro) {
	437	HE* he_cc3_mro_class = hv_fetch_ent(cc3_mro, linear_sv, 0, 0);
	438	if(he_cc3_mro_class) {
3499e05c	439	SV* cc3_mro_class_sv = HeVAL(he_cc3_mro_class);
	440	if(SvROK(cc3_mro_class_sv)) {
	441	HV* cc3_mro_class = (HV*)SvRV(cc3_mro_class_sv);
	442	SV** svp_cc3_mro_class_methods = hv_fetch(cc3_mro_class, "methods", 7, 0);
	443	if(svp_cc3_mro_class_methods) {
	444	SV* cc3_mro_class_methods_sv = *svp_cc3_mro_class_methods;
	445	if(SvROK(cc3_mro_class_methods_sv)) {
	446	HV* cc3_mro_class_methods = (HV*)SvRV(cc3_mro_class_methods_sv);
	447	if(hv_exists_ent(cc3_mro_class_methods, sub_sv, 0))
	448	continue;
	449	}
	450	}
29e61e10	451	}
	452	}
	453	}
	454
b23e9cb9	455	cstash = gv_stashsv(linear_sv, FALSE);
	456
	457	if (!cstash) {
	458	if (ckWARN(WARN_MISC))
	459	Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
	460	(void*)linear_sv, hvname);
	461	continue;
	462	}
	463
	464	assert(cstash);
	465
b23e9cb9	466	gvp = (GV**)hv_fetch(cstash, subname, subname_len, 0);
	467	if (!gvp) continue;
	468
	469	candidate = *gvp;
	470	assert(candidate);
	471
	472	if (SvTYPE(candidate) != SVt_PVGV)
	473	gv_init(candidate, cstash, subname, subname_len, TRUE);
	474	if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
62eb9d08	475	SvREFCNT_dec(linear_av);
b23e9cb9	476	SvREFCNT_inc((SV*)cand_cv);
ddc85d9f	477	if (!hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0)) {
	478	croak("failed to store value in hash");
	479	}
2605e591	480	XPUSHs(sv_2mortal(newRV_inc((SV*)cand_cv)));
2605e591	481	XSRETURN(1);
b23e9cb9	482	}
	483	}
	484	}
	485
62eb9d08	486	SvREFCNT_dec(linear_av);
ddc85d9f	487	if (!hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0)) {
	488	croak("failed to store value in hash");
	489	}
b23e9cb9	490	if(throw_nomethod)
625e16df	491	Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
2605e591	492	XSRETURN_EMPTY;
b23e9cb9	493	}
	494
	495	XS(XS_Class_C3_XS_calculateMRO);
	496	XS(XS_Class_C3_XS_calculateMRO)
	497	{
b23e9cb9	498	dVAR; dXSARGS;
b23e9cb9	499
	500	SV* classname;
	501	HV* class_stash;
	502	HV* cache = NULL;
	503	AV* res;
	504	I32 res_items;
	505	I32 ret_items;
	506	SV** res_ptr;
	507
	508	if(items < 1 \|\| items > 2)
	509	croak("Usage: calculateMRO(classname[, cache])");
	510
	511	classname = ST(0);
f0294f1b	512	if(items == 2) cache = (HV*)SvRV(ST(1));
b23e9cb9	513
b23e9cb9	514	class_stash = gv_stashsv(classname, 0);
625e16df	515	if(!class_stash)
625e16df	516	Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));
b23e9cb9	517
62eb9d08	518	res = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
b23e9cb9	519
b23e9cb9	520	res_items = ret_items = AvFILLp(res) + 1;
	521	res_ptr = AvARRAY(res);
	522
	523	SP -= items;
	524
	525	while(res_items--) {
	526	SV* res_item = *res_ptr++;
62eb9d08	527	XPUSHs(sv_2mortal(newSVsv(res_item)));
b23e9cb9	528	}
62eb9d08	529	SvREFCNT_dec(res);
b23e9cb9	530
	531	PUTBACK;
	532
	533	return;
	534	}
	535
8feecaf9	536	XS(XS_Class_C3_XS_plsubgen);
	537	XS(XS_Class_C3_XS_plsubgen)
	538	{
25dc7e96	539	dVAR; dXSARGS;
8feecaf9	540
	541	SP -= items;
	542	XPUSHs(sv_2mortal(newSViv(PL_sub_generation)));
	543	PUTBACK;
	544	return;
	545	}
	546
625e16df	547	XS(XS_Class_C3_XS_calc_mdt);
	548	XS(XS_Class_C3_XS_calc_mdt)
	549	{
625e16df	550	dVAR; dXSARGS;
625e16df	551
	552	SV* classname;
	553	HV* cache;
	554	HV* class_stash;
	555	AV* class_mro;
	556	HV* our_c3mro; /* $Class::C3::MRO{classname} */
79782a49	557	SV* has_ovf = NULL;
625e16df	558	HV* methods;
	559	I32 mroitems;
	560
	561	/* temps */
	562	HV* hv;
	563	HE* he;
625e16df	564	SV** svp;
	565
	566	if(items < 1 \|\| items > 2)
	567	croak("Usage: calculate_method_dispatch_table(classname[, cache])");
	568
	569	classname = ST(0);
	570	class_stash = gv_stashsv(classname, 0);
	571	if(!class_stash)
	572	Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));
	573
	574	if(items == 2) cache = (HV*)SvRV(ST(1));
	575
	576	class_mro = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
	577
	578	our_c3mro = newHV();
ddc85d9f	579	if(!hv_store(our_c3mro, "MRO", 3, (SV)newRV_noinc((SV)class_mro), 0)) {
	580	croak("failed to store value in hash");
	581	}
625e16df	582
625e16df	583	hv = get_hv("Class::C3::MRO", 1);
ddc85d9f	584	if(!hv_store_ent(hv, classname, (SV)newRV_noinc((SV)our_c3mro), 0)) {
	585	croak("failed to store value in hash");
	586	}
625e16df	587
	588	methods = newHV();
	589
	590	/* skip first entry */
	591	mroitems = AvFILLp(class_mro);
	592	svp = AvARRAY(class_mro) + 1;
	593	while(mroitems--) {
	594	SV* mro_class = *svp++;
	595	HV* mro_stash = gv_stashsv(mro_class, 0);
	596
	597	if(!mro_stash) continue;
	598
79782a49	599	if(!has_ovf) {
625e16df	600	SV** ovfp = hv_fetch(mro_stash, "()", 2, 0);
625e16df	601	if(ovfp) has_ovf = *ovfp;
79782a49	602	}
625e16df	603
625e16df	604	hv_iterinit(mro_stash);
ad2debb2	605	while((he = hv_iternext(mro_stash))) {
625e16df	606	CV* code;
625e16df	607	SV* mskey;
79782a49	608	SV* msval;
	609	HE* ourent;
	610	HV* meth_hash;
	611	SV* orig;
625e16df	612
	613	mskey = hv_iterkeysv(he);
	614	if(hv_exists_ent(methods, mskey, 0)) continue;
79782a49	615
	616	msval = hv_iterval(mro_stash, he);
	617	if(SvTYPE(msval) != SVt_PVGV \|\| !(code = GvCVu(msval)))
	618	continue;
	619
	620	if((ourent = hv_fetch_ent(class_stash, mskey, 0, 0))) {
	621	SV* val = HeVAL(ourent);
	622	if(val && SvTYPE(val) == SVt_PVGV && GvCVu(val))
625e16df	623	continue;
	624	}
	625
79782a49	626	meth_hash = newHV();
	627	orig = newSVsv(mro_class);
	628	sv_catpvn(orig, "::", 2);
	629	sv_catsv(orig, mskey);
ddc85d9f	630	if( !hv_store(meth_hash, "orig", 4, orig, 0)
	631	\|\| !hv_store(meth_hash, "code", 4, newRV_inc((SV*)code), 0)
	632	\|\| !hv_store_ent(methods, mskey, newRV_noinc((SV*)meth_hash), 0) ) {
	633	croak("failed to store value in hash");
	634	}
625e16df	635	}
	636	}
	637
ddc85d9f	638	if(!hv_store(our_c3mro, "methods", 7, newRV_noinc((SV*)methods), 0)) {
	639	croak("failed to store value in hash");
	640	}
	641	if(has_ovf) {
	642	if(!hv_store(our_c3mro, "has_overload_fallback", 21, SvREFCNT_inc(has_ovf), 0)) {
	643	croak("failed to store value in hash");
	644	}
	645	}
625e16df	646	XSRETURN_EMPTY;
	647	}
	648
6ed110b7	649	MODULE = Class::C3::XS PACKAGE = Class::C3::XS
b23e9cb9	650
df0af0e2	651	PROTOTYPES: DISABLED
df0af0e2	652
b23e9cb9	653	BOOT:
b23e9cb9	654	newXS("Class::C3::XS::calculateMRO", XS_Class_C3_XS_calculateMRO, __FILE__);
8feecaf9	655	newXS("Class::C3::XS::_plsubgen", XS_Class_C3_XS_plsubgen, __FILE__);
625e16df	656	newXS("Class::C3::XS::_calculate_method_dispatch_table", XS_Class_C3_XS_calc_mdt, __FILE__);
2605e591	657	newXS("Class::C3::XS::_nextcan", XS_Class_C3_XS_nextcan, __FILE__);
625e16df	658