XS.xs

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