[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) {
                        hv_store_ent(tails, seqitem, newSViv(1), 0);
                    }
                    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) {
                /* we have to do some cleanup before we croak */

                SvREFCNT_dec(retval);
                Safefree(heads);

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

    if(!made_mortal_cache) {
        SvREFCNT_inc(retval);
        hv_store(cache, stashname, stashname_len, (SV*)retval, 0);
    }

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

STATIC SV*
__nextcan(pTHX_ SV* self, I32 throw_nomethod)
{
    register I32 cxix;
    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 items;
    HV* nmcache;
    HE* cache_entry;
    SV* cachekey;

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

    cxix = __dopoptosub_at(cxstack, cxstack_ix);

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

    /* 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);
            return &PL_sv_undef;
        }
        return SvREFCNT_inc(val);
    }

    /* 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);
    items = AvFILLp(linear_av) + 1;

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

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

        while (items--) {
            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);
                hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0);
                return (SV*)cand_cv;
            }
        }
    }

    SvREFCNT_dec(linear_av);
    hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0);
    if(throw_nomethod)
        Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
    return &PL_sv_undef;
}

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();
    hv_store(our_c3mro, "MRO", 3, (SV*)newRV_noinc((SV*)class_mro), 0);

    hv = get_hv("Class::C3::MRO", 1);
    hv_store_ent(hv, classname, (SV*)newRV_noinc((SV*)our_c3mro), 0);

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

    hv_store(our_c3mro, "methods", 7, newRV_noinc((SV*)methods), 0);
    if(has_ovf) hv_store(our_c3mro, "has_overload_fallback", 21, SvREFCNT_inc(has_ovf), 0);
    XSRETURN_EMPTY;
}

XS(XS_next_can);
XS(XS_next_can)
{
    dVAR; dXSARGS;

    SV* self = ST(0);
    SV* methcv = __nextcan(aTHX_ self, 0);

    PERL_UNUSED_VAR(items);

    if(methcv == &PL_sv_undef) {
        ST(0) = &PL_sv_undef;
    }
    else {
        ST(0) = sv_2mortal(newRV_inc(methcv));
    }

    XSRETURN(1);
}

XS(XS_next_method);
XS(XS_next_method)
{
    dMARK;
    dAX;
    SV* self = ST(0);
    SV* methcv = __nextcan(aTHX_ self, 1);

    PL_markstack_ptr++;
    call_sv(methcv, GIMME_V);
}

XS(XS_maybe_next_method);
XS(XS_maybe_next_method)
{
    dMARK;
    dAX;
    SV* self = ST(0);
    SV* methcv = __nextcan(aTHX_ self, 0);

    if(methcv == &PL_sv_undef) {
        ST(0) = &PL_sv_undef;
        XSRETURN(1);
    }

    PL_markstack_ptr++;
    call_sv(methcv, GIMME_V);
}

MODULE = Class::C3::XS	PACKAGE = Class::C3::XS

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