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