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