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