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