This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase $mro::VERSION to 1.13
[perl5.git] / ext / mro / mro.xs
1 #define PERL_NO_GET_CONTEXT
2
3 #include "EXTERN.h"
4 #include "perl.h"
5 #include "XSUB.h"
6
7 static AV*
8 S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level);
9
10 static const struct mro_alg c3_alg =
11     {S_mro_get_linear_isa_c3, "c3", 2, 0, 0};
12
13 /*
14 =for apidoc mro_get_linear_isa_c3
15
16 Returns the C3 linearization of @ISA
17 the given stash.  The return value is a read-only AV*.
18 C<level> should be 0 (it is used internally in this
19 function's recursion).
20
21 You are responsible for C<SvREFCNT_inc()> on the
22 return value if you plan to store it anywhere
23 semi-permanently (otherwise it might be deleted
24 out from under you the next time the cache is
25 invalidated).
26
27 =cut
28 */
29
30 static AV*
31 S_mro_get_linear_isa_c3(pTHX_ HV* stash, U32 level)
32 {
33     AV* retval;
34     GV** gvp;
35     GV* gv;
36     AV* isa;
37     const HEK* stashhek;
38     struct mro_meta* meta;
39
40     assert(HvAUX(stash));
41
42     stashhek = HvENAME_HEK(stash);
43     if (!stashhek) stashhek = HvNAME_HEK(stash);
44     if (!stashhek)
45       Perl_croak(aTHX_ "Can't linearize anonymous symbol table");
46
47     if (level > 100)
48         Perl_croak(aTHX_ "Recursive inheritance detected in package '%"SVf"'",
49                    SVfARG(sv_2mortal(newSVhek(stashhek))));
50
51     meta = HvMROMETA(stash);
52
53     /* return cache if valid */
54     if((retval = MUTABLE_AV(MRO_GET_PRIVATE_DATA(meta, &c3_alg)))) {
55         return retval;
56     }
57
58     /* not in cache, make a new one */
59
60     gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
61     isa = (gvp && (gv = *gvp) && isGV_with_GP(gv)) ? GvAV(gv) : NULL;
62
63     /* For a better idea how the rest of this works, see the much clearer
64        pure perl version in Algorithm::C3 0.01:
65        http://search.cpan.org/src/STEVAN/Algorithm-C3-0.01/lib/Algorithm/C3.pm
66        (later versions go about it differently than this code for speed reasons)
67     */
68
69     if(isa && AvFILLp(isa) >= 0) {
70         SV** seqs_ptr;
71         I32 seqs_items;
72         HV *tails;
73         AV *const seqs = MUTABLE_AV(sv_2mortal(MUTABLE_SV(newAV())));
74         I32* heads;
75
76         /* This builds @seqs, which is an array of arrays.
77            The members of @seqs are the MROs of
78            the members of @ISA, followed by @ISA itself.
79         */
80         I32 items = AvFILLp(isa) + 1;
81         SV** isa_ptr = AvARRAY(isa);
82         while(items--) {
83             SV* const isa_item = *isa_ptr++;
84             HV* const isa_item_stash = gv_stashsv(isa_item, 0);
85             if(!isa_item_stash) {
86                 /* if no stash, make a temporary fake MRO
87                    containing just itself */
88                 AV* const isa_lin = newAV();
89                 av_push(isa_lin, newSVsv(isa_item));
90                 av_push(seqs, MUTABLE_SV(isa_lin));
91             }
92             else {
93                 /* recursion */
94                 AV* const isa_lin
95                   = S_mro_get_linear_isa_c3(aTHX_ isa_item_stash, level + 1);
96
97                 if(items == 0 && AvFILLp(seqs) == -1) {
98                     /* Only one parent class. For this case, the C3
99                        linearisation is this class followed by the parent's
100                        linearisation, so don't bother with the expensive
101                        calculation.  */
102                     SV **svp;
103                     I32 subrv_items = AvFILLp(isa_lin) + 1;
104                     SV *const *subrv_p = AvARRAY(isa_lin);
105
106                     /* Hijack the allocated but unused array seqs to be the
107                        return value. It's currently mortalised.  */
108
109                     retval = seqs;
110
111                     av_extend(retval, subrv_items);
112                     AvFILLp(retval) = subrv_items;
113                     svp = AvARRAY(retval);
114
115                     /* First entry is this class.  We happen to make a shared
116                        hash key scalar because it's the cheapest and fastest
117                        way to do it.  */
118                     *svp++ = newSVhek(stashhek);
119
120                     while(subrv_items--) {
121                         /* These values are unlikely to be shared hash key
122                            scalars, so no point in adding code to optimising
123                            for a case that is unlikely to be true.
124                            (Or prove me wrong and do it.)  */
125
126                         SV *const val = *subrv_p++;
127                         *svp++ = newSVsv(val);
128                     }
129
130                     SvREFCNT_inc(retval);
131
132                     goto done;
133                 }
134                 av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa_lin)));
135             }
136         }
137         av_push(seqs, SvREFCNT_inc_simple_NN(MUTABLE_SV(isa)));
138         tails = MUTABLE_HV(sv_2mortal(MUTABLE_SV(newHV())));
139
140         /* This builds "heads", which as an array of integer array
141            indices, one per seq, which point at the virtual "head"
142            of the seq (initially zero) */
143         Newxz(heads, AvFILLp(seqs)+1, I32);
144
145         /* This builds %tails, which has one key for every class
146            mentioned in the tail of any sequence in @seqs (tail meaning
147            everything after the first class, the "head").  The value
148            is how many times this key appears in the tails of @seqs.
149         */
150         seqs_ptr = AvARRAY(seqs);
151         seqs_items = AvFILLp(seqs) + 1;
152         while(seqs_items--) {
153             AV *const seq = MUTABLE_AV(*seqs_ptr++);
154             I32 seq_items = AvFILLp(seq);
155             if(seq_items > 0) {
156                 SV** seq_ptr = AvARRAY(seq) + 1;
157                 while(seq_items--) {
158                     SV* const seqitem = *seq_ptr++;
159                     /* LVALUE fetch will create a new undefined SV if necessary
160                      */
161                     HE* const he = hv_fetch_ent(tails, seqitem, 1, 0);
162                     if(he) {
163                         SV* const val = HeVAL(he);
164                         /* For 5.8.0 and later, sv_inc() with increment undef to
165                            an IV of 1, which is what we want for a newly created
166                            entry.  However, for 5.6.x it will become an NV of
167                            1.0, which confuses the SvIVX() checks above.  */
168                         if(SvIOK(val)) {
169                             SvIV_set(val, SvIVX(val) + 1);
170                         } else {
171                             sv_setiv(val, 1);
172                         }
173                     }
174                 }
175             }
176         }
177
178         /* Initialize retval to build the return value in */
179         retval = newAV();
180         av_push(retval, newSVhek(stashhek)); /* us first */
181
182         /* This loop won't terminate until we either finish building
183            the MRO, or get an exception. */
184         while(1) {
185             SV* cand = NULL;
186             SV* winner = NULL;
187             int s;
188
189             /* "foreach $seq (@seqs)" */
190             SV** const avptr = AvARRAY(seqs);
191             for(s = 0; s <= AvFILLp(seqs); s++) {
192                 SV** svp;
193                 AV * const seq = MUTABLE_AV(avptr[s]);
194                 SV* seqhead;
195                 if(!seq) continue; /* skip empty seqs */
196                 svp = av_fetch(seq, heads[s], 0);
197                 seqhead = *svp; /* seqhead = head of this seq */
198                 if(!winner) {
199                     HE* tail_entry;
200                     SV* val;
201                     /* if we haven't found a winner for this round yet,
202                        and this seqhead is not in tails (or the count
203                        for it in tails has dropped to zero), then this
204                        seqhead is our new winner, and is added to the
205                        final MRO immediately */
206                     cand = seqhead;
207                     if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
208                        && (val = HeVAL(tail_entry))
209                        && (SvIVX(val) > 0))
210                            continue;
211                     winner = newSVsv(cand);
212                     av_push(retval, winner);
213                     /* note however that even when we find a winner,
214                        we continue looping over @seqs to do housekeeping */
215                 }
216                 if(!sv_cmp(seqhead, winner)) {
217                     /* Once we have a winner (including the iteration
218                        where we first found him), inc the head ptr
219                        for any seq which had the winner as a head,
220                        NULL out any seq which is now empty,
221                        and adjust tails for consistency */
222
223                     const int new_head = ++heads[s];
224                     if(new_head > AvFILLp(seq)) {
225                         SvREFCNT_dec(avptr[s]);
226                         avptr[s] = NULL;
227                     }
228                     else {
229                         HE* tail_entry;
230                         SV* val;
231                         /* Because we know this new seqhead used to be
232                            a tail, we can assume it is in tails and has
233                            a positive value, which we need to dec */
234                         svp = av_fetch(seq, new_head, 0);
235                         seqhead = *svp;
236                         tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
237                         val = HeVAL(tail_entry);
238                         sv_dec(val);
239                     }
240                 }
241             }
242
243             /* if we found no candidates, we are done building the MRO.
244                !cand means no seqs have any entries left to check */
245             if(!cand) {
246                 Safefree(heads);
247                 break;
248             }
249
250             /* If we had candidates, but nobody won, then the @ISA
251                hierarchy is not C3-incompatible */
252             if(!winner) {
253                 SV *errmsg;
254                 I32 i;
255
256                 errmsg = newSVpvf(
257                             "Inconsistent hierarchy during C3 merge of class '%"SVf"':\n\t"
258                             "current merge results [\n",
259                                             SVfARG(sv_2mortal(newSVhek(stashhek))));
260                 for (i = 0; i <= av_len(retval); i++) {
261                     SV **elem = av_fetch(retval, i, 0);
262                     sv_catpvf(errmsg, "\t\t%"SVf",\n", SVfARG(*elem));
263                 }
264                 sv_catpvf(errmsg, "\t]\n\tmerging failed on '%"SVf"'", SVfARG(cand));
265
266                 /* we have to do some cleanup before we croak */
267
268                 SvREFCNT_dec(retval);
269                 Safefree(heads);
270
271                 Perl_croak(aTHX_ "%"SVf, SVfARG(errmsg));
272             }
273         }
274     }
275     else { /* @ISA was undefined or empty */
276         /* build a retval containing only ourselves */
277         retval = newAV();
278         av_push(retval, newSVhek(stashhek));
279     }
280
281  done:
282     /* we don't want anyone modifying the cache entry but us,
283        and we do so by replacing it completely */
284     SvREADONLY_on(retval);
285
286     return MUTABLE_AV(Perl_mro_set_private_data(aTHX_ meta, &c3_alg,
287                                                 MUTABLE_SV(retval)));
288 }
289
290
291 /* These two are static helpers for next::method and friends,
292    and re-implement a bunch of the code from pp_caller() in
293    a more efficient manner for this particular usage.
294 */
295
296 static I32
297 __dopoptosub_at(const PERL_CONTEXT *cxstk, I32 startingblock) {
298     I32 i;
299     for (i = startingblock; i >= 0; i--) {
300         if(CxTYPE((PERL_CONTEXT*)(&cxstk[i])) == CXt_SUB) return i;
301     }
302     return i;
303 }
304
305 MODULE = mro            PACKAGE = mro           PREFIX = mro_
306
307 void
308 mro_get_linear_isa(...)
309   PROTOTYPE: $;$
310   PREINIT:
311     AV* RETVAL;
312     HV* class_stash;
313     SV* classname;
314   PPCODE:
315     if(items < 1 || items > 2)
316         croak_xs_usage(cv, "classname [, type ]");
317
318     classname = ST(0);
319     class_stash = gv_stashsv(classname, 0);
320
321     if(!class_stash) {
322         /* No stash exists yet, give them just the classname */
323         AV* isalin = newAV();
324         av_push(isalin, newSVsv(classname));
325         ST(0) = sv_2mortal(newRV_noinc(MUTABLE_SV(isalin)));
326         XSRETURN(1);
327     }
328     else if(items > 1) {
329         const struct mro_alg *const algo = Perl_mro_get_from_name(aTHX_ ST(1));
330         if (!algo)
331             Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));
332         RETVAL = algo->resolve(aTHX_ class_stash, 0);
333     }
334     else {
335         RETVAL = mro_get_linear_isa(class_stash);
336     }
337     ST(0) = newRV_inc(MUTABLE_SV(RETVAL));
338     sv_2mortal(ST(0));
339     XSRETURN(1);
340
341 void
342 mro_set_mro(...)
343   PROTOTYPE: $$
344   PREINIT:
345     SV* classname;
346     HV* class_stash;
347     struct mro_meta* meta;
348   PPCODE:
349     if (items != 2)
350         croak_xs_usage(cv, "classname, type");
351
352     classname = ST(0);
353     class_stash = gv_stashsv(classname, GV_ADD);
354     if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname));
355     meta = HvMROMETA(class_stash);
356
357     Perl_mro_set_mro(aTHX_ meta, ST(1));
358
359     XSRETURN_EMPTY;
360
361 void
362 mro_get_mro(...)
363   PROTOTYPE: $
364   PREINIT:
365     SV* classname;
366     HV* class_stash;
367   PPCODE:
368     if (items != 1)
369         croak_xs_usage(cv, "classname");
370
371     classname = ST(0);
372     class_stash = gv_stashsv(classname, 0);
373
374     if (class_stash) {
375         const struct mro_alg *const meta = HvMROMETA(class_stash)->mro_which;
376         ST(0) = newSVpvn_flags(meta->name, meta->length,
377                                SVs_TEMP
378                                | ((meta->kflags & HVhek_UTF8) ? SVf_UTF8 : 0));
379     } else {
380       ST(0) = newSVpvn_flags("dfs", 3, SVs_TEMP);
381     }
382     XSRETURN(1);
383
384 void
385 mro_get_isarev(...)
386   PROTOTYPE: $
387   PREINIT:
388     SV* classname;
389     HE* he;
390     HV* isarev;
391     AV* ret_array;
392   PPCODE:
393     if (items != 1)
394         croak_xs_usage(cv, "classname");
395
396     classname = ST(0);
397
398     he = hv_fetch_ent(PL_isarev, classname, 0, 0);
399     isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
400
401     ret_array = newAV();
402     if(isarev) {
403         HE* iter;
404         hv_iterinit(isarev);
405         while((iter = hv_iternext(isarev)))
406             av_push(ret_array, newSVsv(hv_iterkeysv(iter)));
407     }
408     mXPUSHs(newRV_noinc(MUTABLE_SV(ret_array)));
409
410     PUTBACK;
411
412 void
413 mro_is_universal(...)
414   PROTOTYPE: $
415   PREINIT:
416     SV* classname;
417     HV* isarev;
418     char* classname_pv;
419     STRLEN classname_len;
420     HE* he;
421   PPCODE:
422     if (items != 1)
423         croak_xs_usage(cv, "classname");
424
425     classname = ST(0);
426
427     classname_pv = SvPV(classname,classname_len);
428
429     he = hv_fetch_ent(PL_isarev, classname, 0, 0);
430     isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
431
432     if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL"))
433         || (isarev && hv_exists(isarev, "UNIVERSAL", 9)))
434         XSRETURN_YES;
435     else
436         XSRETURN_NO;
437
438
439 void
440 mro_invalidate_all_method_caches(...)
441   PROTOTYPE: 
442   PPCODE:
443     if (items != 0)
444         croak_xs_usage(cv, "");
445
446     PL_sub_generation++;
447
448     XSRETURN_EMPTY;
449
450 void
451 mro_get_pkg_gen(...)
452   PROTOTYPE: $
453   PREINIT:
454     SV* classname;
455     HV* class_stash;
456   PPCODE:
457     if(items != 1)
458         croak_xs_usage(cv, "classname");
459     
460     classname = ST(0);
461
462     class_stash = gv_stashsv(classname, 0);
463
464     mXPUSHi(class_stash ? HvMROMETA(class_stash)->pkg_gen : 0);
465     
466     PUTBACK;
467
468 void
469 mro__nextcan(...)
470   PREINIT:
471     SV* self = ST(0);
472     const I32 throw_nomethod = SvIVX(ST(1));
473     I32 cxix = cxstack_ix;
474     const PERL_CONTEXT *ccstack = cxstack;
475     const PERL_SI *top_si = PL_curstackinfo;
476     HV* selfstash;
477     SV *stashname;
478     const char *fq_subname;
479     const char *subname;
480     bool subname_utf8 = 0;
481     STRLEN stashname_len;
482     STRLEN subname_len;
483     SV* sv;
484     GV** gvp;
485     AV* linear_av;
486     SV** linear_svp;
487     const char *hvname;
488     I32 entries;
489     struct mro_meta* selfmeta;
490     HV* nmcache;
491     I32 i;
492   PPCODE:
493     PERL_UNUSED_ARG(cv);
494
495     if(sv_isobject(self))
496         selfstash = SvSTASH(SvRV(self));
497     else
498         selfstash = gv_stashsv(self, GV_ADD);
499
500     assert(selfstash);
501
502     hvname = HvNAME_get(selfstash);
503     if (!hvname)
504         Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
505
506     /* This block finds the contextually-enclosing fully-qualified subname,
507        much like looking at (caller($i))[3] until you find a real sub that
508        isn't ANON, etc (also skips over pureperl next::method, etc) */
509     for(i = 0; i < 2; i++) {
510         cxix = __dopoptosub_at(ccstack, cxix);
511         for (;;) {
512             GV* cvgv;
513             STRLEN fq_subname_len;
514
515             /* we may be in a higher stacklevel, so dig down deeper */
516             while (cxix < 0) {
517                 if(top_si->si_type == PERLSI_MAIN)
518                     Perl_croak(aTHX_ "next::method/next::can/maybe::next::method must be used in method context");
519                 top_si = top_si->si_prev;
520                 ccstack = top_si->si_cxstack;
521                 cxix = __dopoptosub_at(ccstack, top_si->si_cxix);
522             }
523
524             if(CxTYPE((PERL_CONTEXT*)(&ccstack[cxix])) != CXt_SUB
525               || (PL_DBsub && GvCV(PL_DBsub) && ccstack[cxix].blk_sub.cv == GvCV(PL_DBsub))) {
526                 cxix = __dopoptosub_at(ccstack, cxix - 1);
527                 continue;
528             }
529
530             {
531                 const I32 dbcxix = __dopoptosub_at(ccstack, cxix - 1);
532                 if (PL_DBsub && GvCV(PL_DBsub) && dbcxix >= 0 && ccstack[dbcxix].blk_sub.cv == GvCV(PL_DBsub)) {
533                     if(CxTYPE((PERL_CONTEXT*)(&ccstack[dbcxix])) != CXt_SUB) {
534                         cxix = dbcxix;
535                         continue;
536                     }
537                 }
538             }
539
540             cvgv = CvGV(ccstack[cxix].blk_sub.cv);
541
542             if(!isGV(cvgv)) {
543                 cxix = __dopoptosub_at(ccstack, cxix - 1);
544                 continue;
545             }
546
547             /* we found a real sub here */
548             sv = sv_newmortal();
549
550             gv_efullname3(sv, cvgv, NULL);
551
552             if(SvPOK(sv)) {
553                 fq_subname = SvPVX(sv);
554                 fq_subname_len = SvCUR(sv);
555
556                 subname_utf8 = SvUTF8(sv) ? 1 : 0;
557                 subname = strrchr(fq_subname, ':');
558             } else {
559                 subname = NULL;
560             }
561
562             if(!subname)
563                 Perl_croak(aTHX_ "next::method/next::can/maybe::next::method cannot find enclosing method");
564
565             subname++;
566             subname_len = fq_subname_len - (subname - fq_subname);
567             if(subname_len == 8 && strEQ(subname, "__ANON__")) {
568                 cxix = __dopoptosub_at(ccstack, cxix - 1);
569                 continue;
570             }
571             break;
572         }
573         cxix--;
574     }
575
576     /* If we made it to here, we found our context */
577
578     /* Initialize the next::method cache for this stash
579        if necessary */
580     selfmeta = HvMROMETA(selfstash);
581     if(!(nmcache = selfmeta->mro_nextmethod)) {
582         nmcache = selfmeta->mro_nextmethod = newHV();
583     }
584     else { /* Use the cached coderef if it exists */
585         HE* cache_entry = hv_fetch_ent(nmcache, sv, 0, 0);
586         if (cache_entry) {
587             SV* const val = HeVAL(cache_entry);
588             if(val == &PL_sv_undef) {
589                 if(throw_nomethod)
590                     Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
591                         SVfARG(newSVpvn_flags(subname, subname_len,
592                                 SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
593                         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
594                 XSRETURN_EMPTY;
595             }
596             mXPUSHs(newRV_inc(val));
597             XSRETURN(1);
598         }
599     }
600
601     /* beyond here is just for cache misses, so perf isn't as critical */
602
603     stashname_len = subname - fq_subname - 2;
604     stashname = newSVpvn_flags(fq_subname, stashname_len,
605                                 SVs_TEMP | (subname_utf8 ? SVf_UTF8 : 0));
606
607     /* has ourselves at the top of the list */
608     linear_av = S_mro_get_linear_isa_c3(aTHX_ selfstash, 0);
609
610     linear_svp = AvARRAY(linear_av);
611     entries = AvFILLp(linear_av) + 1;
612
613     /* Walk down our MRO, skipping everything up
614        to the contextually enclosing class */
615     while (entries--) {
616         SV * const linear_sv = *linear_svp++;
617         assert(linear_sv);
618         if(sv_eq(linear_sv, stashname))
619             break;
620     }
621
622     /* Now search the remainder of the MRO for the
623        same method name as the contextually enclosing
624        method */
625     if(entries > 0) {
626         while (entries--) {
627             SV * const linear_sv = *linear_svp++;
628             HV* curstash;
629             GV* candidate;
630             CV* cand_cv;
631
632             assert(linear_sv);
633             curstash = gv_stashsv(linear_sv, FALSE);
634
635             if (!curstash) {
636                 if (ckWARN(WARN_SYNTAX))
637                     Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%"SVf"::ISA",
638                         (void*)linear_sv,
639                         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
640                 continue;
641             }
642
643             assert(curstash);
644
645             gvp = (GV**)hv_fetch(curstash, subname,
646                                     subname_utf8 ? -(I32)subname_len : (I32)subname_len, 0);
647             if (!gvp) continue;
648
649             candidate = *gvp;
650             assert(candidate);
651
652             if (SvTYPE(candidate) != SVt_PVGV)
653                 gv_init_pvn(candidate, curstash, subname, subname_len,
654                                 GV_ADDMULTI|(subname_utf8 ? SVf_UTF8 : 0));
655
656             /* Notably, we only look for real entries, not method cache
657                entries, because in C3 the method cache of a parent is not
658                valid for the child */
659             if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
660                 SvREFCNT_inc_simple_void_NN(MUTABLE_SV(cand_cv));
661                 (void)hv_store_ent(nmcache, sv, MUTABLE_SV(cand_cv), 0);
662                 mXPUSHs(newRV_inc(MUTABLE_SV(cand_cv)));
663                 XSRETURN(1);
664             }
665         }
666     }
667
668     (void)hv_store_ent(nmcache, sv, &PL_sv_undef, 0);
669     if(throw_nomethod)
670         Perl_croak(aTHX_ "No next::method '%"SVf"' found for %"SVf,
671                          SVfARG(newSVpvn_flags(subname, subname_len,
672                                 SVs_TEMP | ( subname_utf8 ? SVf_UTF8 : 0 ) )),
673                         SVfARG(sv_2mortal(newSVhek( HvNAME_HEK(selfstash) ))));
674     XSRETURN_EMPTY;
675
676 BOOT:
677     Perl_mro_register(aTHX_ &c3_alg);