[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) {
                /* 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);
        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
	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) {
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) {
053556af	234	/* we have to do some cleanup before we croak */
053556af	235
62eb9d08	236	SvREFCNT_dec(retval);
bb82f0c1	237	Safefree(heads);
053556af	238
b23e9cb9	239	Perl_croak(aTHX_ "Inconsistent hierarchy during C3 merge of class '%s': "
b23e9cb9	240	"merging failed on parent '%s'", stashname, SvPV_nolen(cand));
62eb9d08	241	}
b23e9cb9	242	}
b23e9cb9	243	}
053556af	244	else { /* @ISA was undefined or empty */
053556af	245	/* build a retval containing only ourselves */
bb82f0c1	246	retval = newAV();
053556af	247	av_push(retval, newSVpvn(stashname, stashname_len));
bb82f0c1	248	}
b23e9cb9	249
053556af	250	/* we don't want anyone modifying the cache entry but us,
053556af	251	and we do so by replacing it completely */
b23e9cb9	252	SvREADONLY_on(retval);
bb82f0c1	253
	254	if(!made_mortal_cache) {
	255	SvREFCNT_inc(retval);
ddc85d9f	256	if(!hv_store(cache, stashname, stashname_len, (SV*)retval, 0)) {
	257	croak("failed to store value in hash");
	258	}
bb82f0c1	259	}
	260
	261	return retval;
b23e9cb9	262	}
	263
	264	STATIC I32
	265	__dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
	266	I32 i;
	267	for (i = startingblock; i >= 0; i--) {
	268	if(CxTYPE((PERL_CONTEXT*)(&cxstk[i])) == CXt_SUB) return i;
	269	}
	270	return i;
	271	}
	272
2605e591	273	XS(XS_Class_C3_XS_nextcan);
2605e591	274	XS(XS_Class_C3_XS_nextcan)
b23e9cb9	275	{
2605e591	276	dVAR; dXSARGS;
2605e591	277
e5e121c4	278	SV* self = ST(0);
e5e121c4	279	const I32 throw_nomethod = SvIVX(ST(1));
5efa8a5b	280	register I32 cxix = cxstack_ix;
b23e9cb9	281	register const PERL_CONTEXT *ccstack = cxstack;
	282	const PERL_SI *top_si = PL_curstackinfo;
	283	HV* selfstash;
	284	GV* cvgv;
	285	SV *stashname;
	286	const char *fq_subname;
	287	const char *subname;
	288	STRLEN fq_subname_len;
	289	STRLEN stashname_len;
	290	STRLEN subname_len;
	291	SV* sv;
	292	GV** gvp;
	293	AV* linear_av;
	294	SV** linear_svp;
b23e9cb9	295	HV* cstash;
	296	GV* candidate = NULL;
	297	CV* cand_cv = NULL;
	298	const char *hvname;
2605e591	299	I32 entries;
6c88cc6a	300	HV* nmcache;
b23e9cb9	301	HE* cache_entry;
22c6f594	302	SV* cachekey;
54d13ec6	303	I32 i;
b23e9cb9	304
2605e591	305	SP -= items;
2605e591	306
b23e9cb9	307	if(sv_isobject(self))
	308	selfstash = SvSTASH(SvRV(self));
	309	else
	310	selfstash = gv_stashsv(self, 0);
	311
	312	assert(selfstash);
	313
	314	hvname = HvNAME(selfstash);
	315	if (!hvname)
625e16df	316	Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
b23e9cb9	317
b23e9cb9	318	/* This block finds the contextually-enclosing fully-qualified subname,
b23e9cb9	319	much like looking at (caller($i))[3] until you find a real sub that
5efa8a5b	320	isn't ANON, etc (also skips over pureperl next::method, etc) */
	321	for(i = 0; i < 2; i++) {
	322	cxix = __dopoptosub_at(ccstack, cxix);
	323	for (;;) {
	324	/* we may be in a higher stacklevel, so dig down deeper */
	325	while (cxix < 0) {
	326	if(top_si->si_type == PERLSI_MAIN)
	327	Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
	328	top_si = top_si->si_prev;
	329	ccstack = top_si->si_cxstack;
	330	cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
	331	}
b23e9cb9	332
5efa8a5b	333	if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
	334	\|\| (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
	335	cxix = __dopoptosub_at(ccstack, cxix - 1);
	336	continue;
	337	}
b23e9cb9	338
5efa8a5b	339	{
	340	const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
	341	if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
	342	if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
	343	cxix = dbcxix;
	344	continue;
	345	}
b23e9cb9	346	}
b23e9cb9	347	}
b23e9cb9	348
5efa8a5b	349	cvgv = CvGV(ccstack[cxix].blk_sub.cv);
b23e9cb9	350
5efa8a5b	351	if(!isGV(cvgv)) {
	352	cxix = __dopoptosub_at(ccstack, cxix - 1);
	353	continue;
	354	}
b23e9cb9	355
5efa8a5b	356	/* we found a real sub here */
5efa8a5b	357	sv = sv_2mortal(newSV(0));
b23e9cb9	358
5efa8a5b	359	gv_efullname3(sv, cvgv, NULL);
b23e9cb9	360
5efa8a5b	361	fq_subname = SvPVX(sv);
5efa8a5b	362	fq_subname_len = SvCUR(sv);
b23e9cb9	363
5efa8a5b	364	subname = strrchr(fq_subname, ':');
	365	if(!subname)
	366	Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
b23e9cb9	367
5efa8a5b	368	subname++;
	369	subname_len = fq_subname_len - (subname - fq_subname);
	370	if(subname_len == 8 && strEQ(subname, "__ANON__")) {
	371	cxix = __dopoptosub_at(ccstack, cxix - 1);
	372	continue;
	373	}
	374	break;
b23e9cb9	375	}
5efa8a5b	376	cxix--;
b23e9cb9	377	}
	378
	379	/* If we made it to here, we found our context */
	380
22c6f594	381	/* cachekey = "objpkg\|context::method::name" */
	382	cachekey = sv_2mortal(newSVpv(hvname, 0));
	383	sv_catpvn(cachekey, "\|", 1);
	384	sv_catsv(cachekey, sv);
b23e9cb9	385
6c88cc6a	386	nmcache = get_hv("next::METHOD_CACHE", 1);
22c6f594	387	if((cache_entry = hv_fetch_ent(nmcache, cachekey, 0, 0))) {
b23e9cb9	388	SV* val = HeVAL(cache_entry);
	389	if(val == &PL_sv_undef) {
	390	if(throw_nomethod)
625e16df	391	Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
2605e591	392	XSRETURN_EMPTY;
b23e9cb9	393	}
2605e591	394	XPUSHs(sv_2mortal(newRV_inc(val)));
2605e591	395	XSRETURN(1);
b23e9cb9	396	}
b23e9cb9	397
	398	/* beyond here is just for cache misses, so perf isn't as critical */
	399
	400	stashname_len = subname - fq_subname - 2;
	401	stashname = sv_2mortal(newSVpvn(fq_subname, stashname_len));
	402
62eb9d08	403	linear_av = __mro_linear_isa_c3(aTHX_ selfstash, NULL, 0);
b23e9cb9	404
b23e9cb9	405	linear_svp = AvARRAY(linear_av);
2605e591	406	entries = AvFILLp(linear_av) + 1;
b23e9cb9	407
2605e591	408	while (entries--) {
053556af	409	SV* const linear_sv = *linear_svp++;
b23e9cb9	410	assert(linear_sv);
	411	if(sv_eq(linear_sv, stashname))
	412	break;
	413	}
	414
2605e591	415	if(entries > 0) {
29e61e10	416	SV* sub_sv = sv_2mortal(newSVpv(subname, subname_len));
29e61e10	417	HV* cc3_mro = get_hv("Class::C3::MRO", 0);
29e61e10	418
2605e591	419	while (entries--) {
053556af	420	SV* const linear_sv = *linear_svp++;
b23e9cb9	421	assert(linear_sv);
29e61e10	422
	423	if(cc3_mro) {
	424	HE* he_cc3_mro_class = hv_fetch_ent(cc3_mro, linear_sv, 0, 0);
	425	if(he_cc3_mro_class) {
3499e05c	426	SV* cc3_mro_class_sv = HeVAL(he_cc3_mro_class);
	427	if(SvROK(cc3_mro_class_sv)) {
	428	HV* cc3_mro_class = (HV*)SvRV(cc3_mro_class_sv);
	429	SV** svp_cc3_mro_class_methods = hv_fetch(cc3_mro_class, "methods", 7, 0);
	430	if(svp_cc3_mro_class_methods) {
	431	SV* cc3_mro_class_methods_sv = *svp_cc3_mro_class_methods;
	432	if(SvROK(cc3_mro_class_methods_sv)) {
	433	HV* cc3_mro_class_methods = (HV*)SvRV(cc3_mro_class_methods_sv);
	434	if(hv_exists_ent(cc3_mro_class_methods, sub_sv, 0))
	435	continue;
	436	}
	437	}
29e61e10	438	}
	439	}
	440	}
	441
b23e9cb9	442	cstash = gv_stashsv(linear_sv, FALSE);
	443
	444	if (!cstash) {
	445	if (ckWARN(WARN_MISC))
	446	Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
	447	(void*)linear_sv, hvname);
	448	continue;
	449	}
	450
	451	assert(cstash);
	452
b23e9cb9	453	gvp = (GV**)hv_fetch(cstash, subname, subname_len, 0);
	454	if (!gvp) continue;
	455
	456	candidate = *gvp;
	457	assert(candidate);
	458
	459	if (SvTYPE(candidate) != SVt_PVGV)
	460	gv_init(candidate, cstash, subname, subname_len, TRUE);
	461	if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
62eb9d08	462	SvREFCNT_dec(linear_av);
b23e9cb9	463	SvREFCNT_inc((SV*)cand_cv);
ddc85d9f	464	if (!hv_store_ent(nmcache, newSVsv(cachekey), (SV*)cand_cv, 0)) {
	465	croak("failed to store value in hash");
	466	}
2605e591	467	XPUSHs(sv_2mortal(newRV_inc((SV*)cand_cv)));
2605e591	468	XSRETURN(1);
b23e9cb9	469	}
	470	}
	471	}
	472
62eb9d08	473	SvREFCNT_dec(linear_av);
ddc85d9f	474	if (!hv_store_ent(nmcache, newSVsv(cachekey), &PL_sv_undef, 0)) {
	475	croak("failed to store value in hash");
	476	}
b23e9cb9	477	if(throw_nomethod)
625e16df	478	Perl_croak(aTHX_ "No next::method '%s' found for %s", subname, hvname);
2605e591	479	XSRETURN_EMPTY;
b23e9cb9	480	}
	481
	482	XS(XS_Class_C3_XS_calculateMRO);
	483	XS(XS_Class_C3_XS_calculateMRO)
	484	{
b23e9cb9	485	dVAR; dXSARGS;
b23e9cb9	486
	487	SV* classname;
	488	HV* class_stash;
	489	HV* cache = NULL;
	490	AV* res;
	491	I32 res_items;
	492	I32 ret_items;
	493	SV** res_ptr;
	494
	495	if(items < 1 \|\| items > 2)
	496	croak("Usage: calculateMRO(classname[, cache])");
	497
	498	classname = ST(0);
f0294f1b	499	if(items == 2) cache = (HV*)SvRV(ST(1));
b23e9cb9	500
b23e9cb9	501	class_stash = gv_stashsv(classname, 0);
625e16df	502	if(!class_stash)
625e16df	503	Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));
b23e9cb9	504
62eb9d08	505	res = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
b23e9cb9	506
b23e9cb9	507	res_items = ret_items = AvFILLp(res) + 1;
	508	res_ptr = AvARRAY(res);
	509
	510	SP -= items;
	511
	512	while(res_items--) {
	513	SV* res_item = *res_ptr++;
62eb9d08	514	XPUSHs(sv_2mortal(newSVsv(res_item)));
b23e9cb9	515	}
62eb9d08	516	SvREFCNT_dec(res);
b23e9cb9	517
	518	PUTBACK;
	519
	520	return;
	521	}
	522
8feecaf9	523	XS(XS_Class_C3_XS_plsubgen);
	524	XS(XS_Class_C3_XS_plsubgen)
	525	{
25dc7e96	526	dVAR; dXSARGS;
8feecaf9	527
	528	SP -= items;
	529	XPUSHs(sv_2mortal(newSViv(PL_sub_generation)));
	530	PUTBACK;
	531	return;
	532	}
	533
625e16df	534	XS(XS_Class_C3_XS_calc_mdt);
	535	XS(XS_Class_C3_XS_calc_mdt)
	536	{
625e16df	537	dVAR; dXSARGS;
625e16df	538
	539	SV* classname;
	540	HV* cache;
	541	HV* class_stash;
	542	AV* class_mro;
	543	HV* our_c3mro; /* $Class::C3::MRO{classname} */
79782a49	544	SV* has_ovf = NULL;
625e16df	545	HV* methods;
	546	I32 mroitems;
	547
	548	/* temps */
	549	HV* hv;
	550	HE* he;
625e16df	551	SV** svp;
	552
	553	if(items < 1 \|\| items > 2)
	554	croak("Usage: calculate_method_dispatch_table(classname[, cache])");
	555
	556	classname = ST(0);
	557	class_stash = gv_stashsv(classname, 0);
	558	if(!class_stash)
	559	Perl_croak(aTHX_ "No such class: '%s'!", SvPV_nolen(classname));
	560
	561	if(items == 2) cache = (HV*)SvRV(ST(1));
	562
	563	class_mro = __mro_linear_isa_c3(aTHX_ class_stash, cache, 0);
	564
	565	our_c3mro = newHV();
ddc85d9f	566	if(!hv_store(our_c3mro, "MRO", 3, (SV)newRV_noinc((SV)class_mro), 0)) {
	567	croak("failed to store value in hash");
	568	}
625e16df	569
625e16df	570	hv = get_hv("Class::C3::MRO", 1);
ddc85d9f	571	if(!hv_store_ent(hv, classname, (SV)newRV_noinc((SV)our_c3mro), 0)) {
	572	croak("failed to store value in hash");
	573	}
625e16df	574
	575	methods = newHV();
	576
	577	/* skip first entry */
	578	mroitems = AvFILLp(class_mro);
	579	svp = AvARRAY(class_mro) + 1;
	580	while(mroitems--) {
	581	SV* mro_class = *svp++;
	582	HV* mro_stash = gv_stashsv(mro_class, 0);
	583
	584	if(!mro_stash) continue;
	585
79782a49	586	if(!has_ovf) {
625e16df	587	SV** ovfp = hv_fetch(mro_stash, "()", 2, 0);
625e16df	588	if(ovfp) has_ovf = *ovfp;
79782a49	589	}
625e16df	590
625e16df	591	hv_iterinit(mro_stash);
ad2debb2	592	while((he = hv_iternext(mro_stash))) {
625e16df	593	CV* code;
625e16df	594	SV* mskey;
79782a49	595	SV* msval;
	596	HE* ourent;
	597	HV* meth_hash;
	598	SV* orig;
625e16df	599
	600	mskey = hv_iterkeysv(he);
	601	if(hv_exists_ent(methods, mskey, 0)) continue;
79782a49	602
	603	msval = hv_iterval(mro_stash, he);
	604	if(SvTYPE(msval) != SVt_PVGV \|\| !(code = GvCVu(msval)))
	605	continue;
	606
	607	if((ourent = hv_fetch_ent(class_stash, mskey, 0, 0))) {
	608	SV* val = HeVAL(ourent);
	609	if(val && SvTYPE(val) == SVt_PVGV && GvCVu(val))
625e16df	610	continue;
	611	}
	612
79782a49	613	meth_hash = newHV();
	614	orig = newSVsv(mro_class);
	615	sv_catpvn(orig, "::", 2);
	616	sv_catsv(orig, mskey);
ddc85d9f	617	if( !hv_store(meth_hash, "orig", 4, orig, 0)
	618	\|\| !hv_store(meth_hash, "code", 4, newRV_inc((SV*)code), 0)
	619	\|\| !hv_store_ent(methods, mskey, newRV_noinc((SV*)meth_hash), 0) ) {
	620	croak("failed to store value in hash");
	621	}
625e16df	622	}
	623	}
	624
ddc85d9f	625	if(!hv_store(our_c3mro, "methods", 7, newRV_noinc((SV*)methods), 0)) {
	626	croak("failed to store value in hash");
	627	}
	628	if(has_ovf) {
	629	if(!hv_store(our_c3mro, "has_overload_fallback", 21, SvREFCNT_inc(has_ovf), 0)) {
	630	croak("failed to store value in hash");
	631	}
	632	}
625e16df	633	XSRETURN_EMPTY;
	634	}
	635
b23e9cb9	636	MODULE = Class::C3::XS PACKAGE = Class::C3::XS
b23e9cb9	637
df0af0e2	638	PROTOTYPES: DISABLED
df0af0e2	639
b23e9cb9	640	BOOT:
b23e9cb9	641	newXS("Class::C3::XS::calculateMRO", XS_Class_C3_XS_calculateMRO, __FILE__);
8feecaf9	642	newXS("Class::C3::XS::_plsubgen", XS_Class_C3_XS_plsubgen, __FILE__);
625e16df	643	newXS("Class::C3::XS::_calculate_method_dispatch_table", XS_Class_C3_XS_calc_mdt, __FILE__);
2605e591	644	newXS("Class::C3::XS::_nextcan", XS_Class_C3_XS_nextcan, __FILE__);
625e16df	645