[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 */

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