--- /dev/null
+=== embed.h
+==================================================================
+--- embed.h (/local/perl-current) (revision 12336)
++++ embed.h (/local/perl-c3) (revision 12336)
+@@ -266,6 +266,11 @@
+ #define gv_efullname Perl_gv_efullname
+ #define gv_efullname4 Perl_gv_efullname4
+ #define gv_fetchfile Perl_gv_fetchfile
++#ifdef PERL_CORE
++#define linear_isa Perl_linear_isa
++#define linear_isa_c3 Perl_linear_isa_c3
++#define linear_isa_dfs Perl_linear_isa_dfs
++#endif
+ #define gv_fetchmeth Perl_gv_fetchmeth
+ #define gv_fetchmeth_autoload Perl_gv_fetchmeth_autoload
+ #define gv_fetchmethod_autoload Perl_gv_fetchmethod_autoload
+@@ -2470,6 +2475,11 @@
+ #define gv_efullname(a,b) Perl_gv_efullname(aTHX_ a,b)
+ #define gv_efullname4(a,b,c,d) Perl_gv_efullname4(aTHX_ a,b,c,d)
+ #define gv_fetchfile(a) Perl_gv_fetchfile(aTHX_ a)
++#ifdef PERL_CORE
++#define linear_isa(a) Perl_linear_isa(aTHX_ a)
++#define linear_isa_c3(a) Perl_linear_isa_c3(aTHX_ a)
++#define linear_isa_dfs(a,b) Perl_linear_isa_dfs(aTHX_ a,b)
++#endif
+ #define gv_fetchmeth(a,b,c,d) Perl_gv_fetchmeth(aTHX_ a,b,c,d)
+ #define gv_fetchmeth_autoload(a,b,c,d) Perl_gv_fetchmeth_autoload(aTHX_ a,b,c,d)
+ #define gv_fetchmethod_autoload(a,b,c) Perl_gv_fetchmethod_autoload(aTHX_ a,b,c)
+=== embedvar.h
+==================================================================
+--- embedvar.h (/local/perl-current) (revision 12336)
++++ embedvar.h (/local/perl-c3) (revision 12336)
+@@ -229,6 +229,7 @@
+ #define PL_incgv (vTHX->Iincgv)
+ #define PL_initav (vTHX->Iinitav)
+ #define PL_inplace (vTHX->Iinplace)
++#define PL_isa_generation (vTHX->Iisa_generation)
+ #define PL_known_layers (vTHX->Iknown_layers)
+ #define PL_last_lop (vTHX->Ilast_lop)
+ #define PL_last_lop_op (vTHX->Ilast_lop_op)
+@@ -527,6 +528,7 @@
+ #define PL_Iincgv PL_incgv
+ #define PL_Iinitav PL_initav
+ #define PL_Iinplace PL_inplace
++#define PL_Iisa_generation PL_isa_generation
+ #define PL_Iknown_layers PL_known_layers
+ #define PL_Ilast_lop PL_last_lop
+ #define PL_Ilast_lop_op PL_last_lop_op
+=== gv.c
+==================================================================
+--- gv.c (/local/perl-current) (revision 12336)
++++ gv.c (/local/perl-c3) (revision 12336)
+@@ -283,6 +283,325 @@
+ }
+
+ /*
++=for apidoc linear_isa_dfs
++
++Returns the Depth-First Search linearization of @ISA
++the given stash. The return value is a read-only AV*,
++and is cached based on C<PL_isa_generation>.
++
++=cut
++*/
++AV*
++Perl_linear_isa_dfs(pTHX_ HV *stash, I32 level) {
++ AV* retval;
++ GV** gvp;
++ GV* gv;
++ AV* av;
++ SV** svp;
++ I32 items;
++ AV* subrv;
++ SV** subrv_p;
++ I32 subrv_items;
++ const char* stashname;
++
++ assert(stash);
++ assert(HvAUX(stash));
++
++ stashname = HvNAME_get(stash);
++ if (!stashname)
++ Perl_croak(aTHX_
++ "Can't linearize anonymous symbol table");
++
++ if (level > 100)
++ Perl_croak(aTHX_ "Recursive inheritance detected in package '%s'",
++ stashname);
++
++ /* return the cached linearization if valid */
++ if((retval = HvAUX(stash)->xhv_dfs_linear_isa)
++ && HvAUX(stash)->xhv_dfs_isa_gen == PL_isa_generation) {
++ SvREFCNT_inc_simple_void_NN(retval);
++ return retval;
++ }
++
++ /* make a new one */
++
++ if(retval) SvREFCNT_dec(retval);
++ HvAUX(stash)->xhv_dfs_linear_isa = retval = newAV();
++ HvAUX(stash)->xhv_dfs_isa_gen = PL_isa_generation;
++ av_push(retval, newSVpv(stashname, 0)); /* add ourselves at the top */
++
++ gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
++ av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL;
++
++ if(av) {
++ svp = AvARRAY(av);
++ items = AvFILLp(av) + 1;
++ while (items--) {
++ SV* const sv = *svp++;
++ HV* const basestash = gv_stashsv(sv, FALSE);
++ if (!basestash) {
++ if (ckWARN(WARN_MISC))
++ Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
++ (void*)sv, stashname);
++ continue;
++ }
++ subrv = linear_isa_dfs(basestash, level + 1);
++ subrv_p = AvARRAY(subrv);
++ subrv_items = AvFILLp(subrv) + 1;
++ while(subrv_items--) {
++ SV* subsv = *subrv_p++;
++ SvREFCNT_inc_simple_void_NN(subsv);
++ av_push(retval, subsv);
++ }
++ SvREFCNT_dec(subrv);
++ }
++ }
++
++ SvREADONLY_on(retval);
++ SvREFCNT_inc_simple_void_NN(retval);
++ return retval;
++}
++
++AV* __av_shallow_copy(AV* inav) {
++ AV* outav = newAV();
++ SV** inptr = AvARRAY(inav);
++ I32 items = AvFILLp(inav) + 1;
++ while(items--) {
++ SV* tempsv = *inptr++;
++ SvREFCNT_inc_simple_void_NN(tempsv);
++ av_push(outav, tempsv);
++ }
++ return outav;
++}
++
++/* increment the numeric value of a key in a hash,
++ creating at 1 if neccesary */
++void __hv_incr(HV* inhash, SV* inkey) {
++ HE* he = hv_fetch_ent(inhash, inkey, 0, 0);
++ SV* val;
++ if(!he) {
++ val = newSViv(1);
++ hv_store_ent(inhash, inkey, val, 0);
++ }
++ else {
++ val = HeVAL(he);
++ sv_inc(val);
++ }
++}
++
++/*
++=for apidoc linear_isa_c3
++
++Returns the C3 linearization of @ISA
++the given stash. The return value is a read-only AV*,
++and is cached based on C<PL_isa_generation>.
++
++=cut
++*/
++AV*
++Perl_linear_isa_c3(pTHX_ HV *root) {
++ AV* retval;
++ GV** gvp;
++ GV* gv;
++ AV* crisa;
++ SV** svp;
++ const char* rootname;
++ AV* C3STACK;
++ HV* current_root;
++ AV* recurse_mergeout;
++ SV* isv;
++ HV* seen;
++
++ assert(root);
++ assert(HvAUX(root));
++
++ rootname = HvNAME_get(root);
++ if (!rootname)
++ Perl_croak(aTHX_
++ "Can't linearize anonymous symbol table");
++
++ /* shortcut in the case root's linear isa is already cached */
++ if((retval = HvAUX(root)->xhv_c3_linear_isa)
++ && (HvAUX(root)->xhv_c3_isa_gen == PL_isa_generation)) {
++ SvREFCNT_inc_simple_void_NN(retval);
++ return retval;
++ }
++
++ C3STACK = newAV();
++ current_root = root;
++ recurse_mergeout = newAV();
++ isv = newSViv(0);
++ seen = newHV();
++ hv_store(seen, rootname, strlen(rootname), &PL_sv_yes, 0);
++
++ while(1) {
++ gvp = (GV**)hv_fetchs(current_root, "ISA", FALSE);
++ crisa = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL;
++
++ if(crisa && SvIVX(isv) <= av_len(crisa)) {
++ AV* new_stack_entry;
++ SV* new_root_sv;
++ HV* new_root;
++ const char* new_root_name;
++ int new_root_len;
++ svp = av_fetch(crisa, SvIVX(isv), 0);
++ assert(svp);
++ new_root_sv = *svp;
++ new_root = gv_stashsv(new_root_sv, FALSE);
++ assert(new_root);
++ sv_inc(isv);
++
++ new_root_name = HvNAME_get(new_root);
++ new_root_len = HvNAMELEN_get(new_root);
++ if(hv_exists(seen, new_root_name, new_root_len)) {
++ Perl_croak(aTHX_ "infinite recursion detected");
++ }
++ hv_store(seen, new_root_name, new_root_len, &PL_sv_yes, 0);
++
++ new_stack_entry = newAV();
++ av_push(new_stack_entry, (SV*)current_root);
++ av_push(new_stack_entry, (SV*)recurse_mergeout);
++ av_push(new_stack_entry, isv);
++ av_push(C3STACK, (SV*)new_stack_entry);
++
++ current_root = new_root;
++ recurse_mergeout = newAV();
++ isv = newSViv(0);
++ continue;
++ }
++
++ const char* current_root_name = HvNAME_get(current_root);
++ int current_root_len = HvNAMELEN_get(current_root);
++ SV* current_root_name_sv = newSVpv(current_root_name, current_root_len);
++ hv_delete(seen, current_root_name, current_root_len, G_DISCARD);
++
++ AV* res = HvAUX(current_root)->xhv_c3_linear_isa;
++ if(!res || HvAUX(current_root)->xhv_c3_isa_gen != PL_isa_generation) {
++ if(res) SvREFCNT_dec(res);
++ res = newAV();
++ HV* tails = newHV();
++ AV* seqs = newAV();
++ av_push(res, current_root_name_sv);
++
++ SV** avptr = AvARRAY(recurse_mergeout);
++ I32 items = AvFILLp(recurse_mergeout) + 1;
++ while(items--) {
++ SV** seqptr;
++ I32 seqitems;
++ AV* oseq = (AV*)*avptr++;
++ AV* seq = __av_shallow_copy(oseq);
++ av_push(seqs, (SV*)seq);
++ seqptr = AvARRAY(seq) + 1;
++ seqitems = AvFILLp(seq);
++ while(seqitems--) {
++ __hv_incr(tails, *(seqptr++));
++ }
++ }
++
++ if(crisa) {
++ AV* crisa_seq = __av_shallow_copy(crisa);
++ I32 seqitems = AvFILLp(crisa_seq);
++ if(seqitems >= 0) av_push(seqs, (SV*)crisa_seq);
++ if(seqitems > 0) {
++ SV** seqptr = AvARRAY(crisa_seq) + 1;
++ while(seqitems--) {
++ __hv_incr(tails, *(seqptr++));
++ }
++ }
++ }
++
++ while(1) {
++ SV* seqhead = NULL;
++ SV* cand = NULL;
++ SV* winner = NULL;
++ SV* val;
++ HE* tail_entry;
++ AV* seq;
++ avptr = AvARRAY(seqs);
++ items = AvFILLp(seqs)+1;
++ while(items--) {
++ seq = (AV*)*avptr++;
++ if(AvFILLp(seq) < 0) continue;
++ svp = av_fetch(seq, 0, 0);
++ seqhead = *svp;
++ if(!winner) {
++ cand = seqhead;
++ if((tail_entry = hv_fetch_ent(tails, cand, 0, 0))
++ && (val = HeVAL(tail_entry))
++ && SvIVx(val) > 0)
++ continue;
++ winner = cand;
++ SvREFCNT_inc_simple_void_NN(cand);
++ av_push(res, cand);
++ }
++ if(!sv_cmp(seqhead, winner)) {
++ av_shift(seq);
++ if(AvFILLp(seq) < 0) continue;
++ svp = av_fetch(seq, 0, 0);
++ seqhead = *svp;
++ tail_entry = hv_fetch_ent(tails, seqhead, 0, 0);
++ val = HeVAL(tail_entry);
++ sv_dec(val);
++ }
++ }
++ if(!cand) break;
++ if(!winner) Perl_croak(aTHX_ "Inconsistent hierarchy XXX");
++ }
++ SvREADONLY_on(res);
++ HvAUX(current_root)->xhv_c3_isa_gen = PL_isa_generation;
++ HvAUX(current_root)->xhv_c3_linear_isa = res;
++ SvREFCNT_dec(tails);
++ SvREFCNT_dec(seqs);
++ }
++
++ SvREFCNT_dec(recurse_mergeout);
++ SvREFCNT_dec(isv);
++
++ if(AvFILLp(C3STACK) < 0) {
++ /* clean up our temporaries */
++ SvREFCNT_dec(C3STACK);
++ SvREFCNT_dec(seen);
++ SvREFCNT_inc_simple_void_NN(res);
++ return res;
++ }
++
++ AV* tempav = (AV*)av_pop(C3STACK);
++ svp = av_fetch(tempav, 0, 0);
++ current_root = (HV*)*svp;
++ svp = av_fetch(tempav, 1, 0);
++ recurse_mergeout = (AV*)*svp;
++ svp = av_fetch(tempav, 2, 0);
++ isv = *svp;
++ SvREFCNT_inc_simple_void_NN(current_root);
++ SvREFCNT_inc_simple_void_NN(recurse_mergeout);
++ SvREFCNT_inc_simple_void_NN(isv);
++ SvREFCNT_dec(tempav);
++
++ SvREFCNT_inc_simple_void_NN(res);
++ av_push(recurse_mergeout, (SV*)res);
++ }
++}
++
++/*
++=for apidoc linear_isa
++
++Returns either C<linear_isa_c3> or C<linear_isa_dfs> for
++the given stash, dependant upon which MRO is in effect
++for that stash. The return value is a read-only AV*,
++and is cached based on C<PL_isa_generation>.
++
++=cut
++*/
++AV*
++Perl_linear_isa(pTHX_ HV *stash)
++{
++ assert(stash);
++ assert(HvAUX(stash));
++ return HvC3MRO(stash) ? linear_isa_c3(stash)
++ : linear_isa_dfs(stash, 0);
++}
++
++/*
+ =for apidoc gv_fetchmeth
+
+ Returns the glob with the given C<name> and a defined subroutine or
+@@ -292,7 +611,7 @@
+ The argument C<level> should be either 0 or -1. If C<level==0>, as a
+ side-effect creates a glob with the given C<name> in the given C<stash>
+ which in the case of success contains an alias for the subroutine, and sets
+-up caching info for this glob. Similarly for all the searched stashes.
++up caching info for this glob.
+
+ This function grants C<"SUPER"> token as a postfix of the stash name. The
+ GV returned from C<gv_fetchmeth> may be a method cache entry, which is not
+@@ -303,133 +622,139 @@
+ =cut
+ */
+
++/* NOTE: No support for tied ISA */
++
+ GV *
+ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
+ {
+ dVAR;
+- AV* av;
+- GV* topgv;
+- GV* gv;
+ GV** gvp;
+- CV* cv;
++ AV* linear_isa_av;
++ SV** linear_isa_svp;
++ SV* linear_isa_sv;
++ HV* curstash;
++ GV* candidate = NULL;
++ CV* cand_cv = NULL;
++ CV* old_cv;
++ GV* topgv = NULL;
+ const char *hvname;
+- HV* lastchance = NULL;
++ I32 create = (level >= 0) ? 1 : 0;
++ I32 items;
++ STRLEN packlen;
+
+ /* UNIVERSAL methods should be callable without a stash */
+ if (!stash) {
+- level = -1; /* probably appropriate */
++ create = 0; /* probably appropriate */
+ if(!(stash = gv_stashpvs("UNIVERSAL", FALSE)))
+ return 0;
+ }
+
++ assert(stash);
++
+ hvname = HvNAME_get(stash);
+ if (!hvname)
+- Perl_croak(aTHX_
+- "Can't use anonymous symbol table for method lookup");
++ Perl_croak(aTHX_ "Can't use anonymous symbol table for method lookup");
+
+- if ((level > 100) || (level < -100))
+- Perl_croak(aTHX_ "Recursive inheritance detected while looking for method '%s' in package '%s'",
+- name, hvname);
++ assert(hvname);
++ assert(name);
++ assert(len >= 0);
+
+ DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
+
+- gvp = (GV**)hv_fetch(stash, name, len, (level >= 0));
+- if (!gvp)
+- topgv = NULL;
++ /* check locally for a real method or a cache entry */
++ gvp = (GV**)hv_fetch(stash, name, len, create);
++ if(gvp) {
++ topgv = *gvp;
++ assert(topgv);
++ if (SvTYPE(topgv) != SVt_PVGV)
++ gv_init(topgv, stash, name, len, TRUE);
++ if ((cand_cv = GvCV(topgv))) {
++ /* If genuine method or valid cache entry, use it */
++ if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation) {
++ return topgv;
++ }
++ else {
++ /* stale cache entry, junk it and move on */
++ SvREFCNT_dec(cand_cv);
++ GvCV(topgv) = cand_cv = NULL;
++ GvCVGEN(topgv) = 0;
++ }
++ }
++ else if (GvCVGEN(topgv) == PL_sub_generation) {
++ /* cache indicates no such method definitively */
++ return 0;
++ }
++ }
++
++ packlen = HvNAMELEN_get(stash);
++ if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
++ HV* basestash;
++ packlen -= 7;
++ basestash = gv_stashpvn(hvname, packlen, TRUE);
++ linear_isa_av = linear_isa(basestash);
++ }
+ else {
+- topgv = *gvp;
+- if (SvTYPE(topgv) != SVt_PVGV)
+- gv_init(topgv, stash, name, len, TRUE);
+- if ((cv = GvCV(topgv))) {
+- /* If genuine method or valid cache entry, use it */
+- if (!GvCVGEN(topgv) || GvCVGEN(topgv) == PL_sub_generation)
+- return topgv;
+- /* Stale cached entry: junk it */
+- SvREFCNT_dec(cv);
+- GvCV(topgv) = cv = NULL;
+- GvCVGEN(topgv) = 0;
+- }
+- else if (GvCVGEN(topgv) == PL_sub_generation)
+- return 0; /* cache indicates sub doesn't exist */
++ linear_isa_av = linear_isa(stash); /* has ourselves at the top of the list */
+ }
+
+- gvp = (GV**)hv_fetchs(stash, "ISA", FALSE);
+- av = (gvp && (gv = *gvp) && gv != (GV*)&PL_sv_undef) ? GvAV(gv) : NULL;
++ linear_isa_svp = AvARRAY(linear_isa_av) + 1; /* skip over self */
++ items = AvFILLp(linear_isa_av); /* no +1, to skip over self */
++ while (items--) {
++ linear_isa_sv = *linear_isa_svp++;
++ assert(linear_isa_sv);
++ curstash = gv_stashsv(linear_isa_sv, FALSE);
+
+- /* create and re-create @.*::SUPER::ISA on demand */
+- if (!av || !SvMAGIC(av)) {
+- STRLEN packlen = HvNAMELEN_get(stash);
++ if (!curstash) {
++ if (ckWARN(WARN_MISC))
++ Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
++ (void*)linear_isa_sv, hvname);
++ continue;
++ }
+
+- if (packlen >= 7 && strEQ(hvname + packlen - 7, "::SUPER")) {
+- HV* basestash;
++ assert(curstash);
+
+- packlen -= 7;
+- basestash = gv_stashpvn(hvname, packlen, TRUE);
+- gvp = (GV**)hv_fetchs(basestash, "ISA", FALSE);
+- if (gvp && (gv = *gvp) != (GV*)&PL_sv_undef && (av = GvAV(gv))) {
+- gvp = (GV**)hv_fetchs(stash, "ISA", TRUE);
+- if (!gvp || !(gv = *gvp))
+- Perl_croak(aTHX_ "Cannot create %s::ISA", hvname);
+- if (SvTYPE(gv) != SVt_PVGV)
+- gv_init(gv, stash, "ISA", 3, TRUE);
+- SvREFCNT_dec(GvAV(gv));
+- GvAV(gv) = (AV*)SvREFCNT_inc_simple(av);
+- }
+- }
++ gvp = (GV**)hv_fetch(curstash, name, len, 0);
++ if (!gvp) continue;
++ candidate = *gvp;
++ assert(candidate);
++ if (SvTYPE(candidate) != SVt_PVGV) gv_init(candidate, curstash, name, len, TRUE);
++ if (SvTYPE(candidate) == SVt_PVGV && (cand_cv = GvCV(candidate)) && !GvCVGEN(candidate)) {
++ /*
++ * Found real method, cache method in topgv if:
++ * 1. topgv has no synonyms (else inheritance crosses wires)
++ * 2. method isn't a stub (else AUTOLOAD fails spectacularly)
++ */
++ if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
++ if ((old_cv = GvCV(topgv))) SvREFCNT_dec(old_cv);
++ SvREFCNT_inc_simple_void_NN(cand_cv);
++ GvCV(topgv) = cand_cv;
++ GvCVGEN(topgv) = PL_sub_generation;
++ }
++ SvREFCNT_dec(linear_isa_av);
++ return candidate;
++ }
+ }
+
+- if (av) {
+- SV** svp = AvARRAY(av);
+- /* NOTE: No support for tied ISA */
+- I32 items = AvFILLp(av) + 1;
+- while (items--) {
+- SV* const sv = *svp++;
+- HV* const basestash = gv_stashsv(sv, FALSE);
+- if (!basestash) {
+- if (ckWARN(WARN_MISC))
+- Perl_warner(aTHX_ packWARN(WARN_MISC), "Can't locate package %"SVf" for @%s::ISA",
+- (void*)sv, hvname);
+- continue;
+- }
+- gv = gv_fetchmeth(basestash, name, len,
+- (level >= 0) ? level + 1 : level - 1);
+- if (gv)
+- goto gotcha;
+- }
++ SvREFCNT_dec(linear_isa_av);
++
++ /* Check UNIVERSAL without caching */
++ if(level == 0 || level == -1) {
++ candidate = gv_fetchmeth(NULL, name, len, 1);
++ if(candidate) {
++ cand_cv = GvCV(candidate);
++ if (topgv && (GvREFCNT(topgv) == 1) && (CvROOT(cand_cv) || CvXSUB(cand_cv))) {
++ if ((old_cv = GvCV(topgv))) SvREFCNT_dec(old_cv);
++ SvREFCNT_inc_simple_void_NN(cand_cv);
++ GvCV(topgv) = cand_cv;
++ GvCVGEN(topgv) = PL_sub_generation;
++ }
++ return candidate;
++ }
+ }
+
+- /* if at top level, try UNIVERSAL */
+-
+- if (level == 0 || level == -1) {
+- lastchance = gv_stashpvs("UNIVERSAL", FALSE);
+-
+- if (lastchance) {
+- if ((gv = gv_fetchmeth(lastchance, name, len,
+- (level >= 0) ? level + 1 : level - 1)))
+- {
+- gotcha:
+- /*
+- * Cache method in topgv if:
+- * 1. topgv has no synonyms (else inheritance crosses wires)
+- * 2. method isn't a stub (else AUTOLOAD fails spectacularly)
+- */
+- if (topgv &&
+- GvREFCNT(topgv) == 1 &&
+- (cv = GvCV(gv)) &&
+- (CvROOT(cv) || CvXSUB(cv)))
+- {
+- if ((cv = GvCV(topgv)))
+- SvREFCNT_dec(cv);
+- GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv));
+- GvCVGEN(topgv) = PL_sub_generation;
+- }
+- return gv;
+- }
+- else if (topgv && GvREFCNT(topgv) == 1) {
+- /* cache the fact that the method is not defined */
+- GvCVGEN(topgv) = PL_sub_generation;
+- }
+- }
++ if (topgv && GvREFCNT(topgv) == 1) {
++ /* cache the fact that the method is not defined */
++ GvCVGEN(topgv) = PL_sub_generation;
+ }
+
+ return 0;
+=== lib/c3mro.pm
+==================================================================
+--- lib/c3mro.pm (/local/perl-current) (revision 12336)
++++ lib/c3mro.pm (/local/perl-c3) (revision 12336)
+@@ -0,0 +1,5 @@
++package c3mro;
++use B qw/ enable_c3mro disable_c3mro /;
++sub import { enable_c3mro(scalar(caller)) }
++sub unimport { disable_c3mro(scalar(caller)) }
++1;
+=== perlapi.h
+==================================================================
+--- perlapi.h (/local/perl-current) (revision 12336)
++++ perlapi.h (/local/perl-c3) (revision 12336)
+@@ -336,6 +336,8 @@
+ #define PL_initav (*Perl_Iinitav_ptr(aTHX))
+ #undef PL_inplace
+ #define PL_inplace (*Perl_Iinplace_ptr(aTHX))
++#undef PL_isa_generation
++#define PL_isa_generation (*Perl_Iisa_generation_ptr(aTHX))
+ #undef PL_known_layers
+ #define PL_known_layers (*Perl_Iknown_layers_ptr(aTHX))
+ #undef PL_last_lop
+=== proto.h
+==================================================================
+--- proto.h (/local/perl-current) (revision 12336)
++++ proto.h (/local/perl-c3) (revision 12336)
+@@ -624,6 +624,15 @@
+ PERL_CALLCONV GV* Perl_gv_fetchfile(pTHX_ const char* name)
+ __attribute__nonnull__(pTHX_1);
+
++PERL_CALLCONV AV* Perl_linear_isa(pTHX_ HV* stash)
++ __attribute__nonnull__(pTHX_1);
++
++PERL_CALLCONV AV* Perl_linear_isa_c3(pTHX_ HV* stash)
++ __attribute__nonnull__(pTHX_1);
++
++PERL_CALLCONV AV* Perl_linear_isa_dfs(pTHX_ HV* stash, I32 level)
++ __attribute__nonnull__(pTHX_1);
++
+ PERL_CALLCONV GV* Perl_gv_fetchmeth(pTHX_ HV* stash, const char* name, STRLEN len, I32 level)
+ __attribute__nonnull__(pTHX_2);
+
+=== ext/B/t/concise-xs.t
+==================================================================
+--- ext/B/t/concise-xs.t (/local/perl-current) (revision 12336)
++++ ext/B/t/concise-xs.t (/local/perl-c3) (revision 12336)
+@@ -117,7 +117,7 @@
+ use Carp;
+ use Test::More tests => ( # per-pkg tests (function ct + require_ok)
+ 40 + 16 # Data::Dumper, Digest::MD5
+- + 517 + 236 # B::Deparse, B
++ + 517 + 243 # B::Deparse, B
+ + 595 + 190 # POSIX, IO::Socket
+ + 3 * ($] > 5.009)
+ + 16 * ($] >= 5.009003)
+@@ -157,7 +157,8 @@
+ formfeed end_av dowarn diehook defstash curstash
+ cstring comppadlist check_av cchar cast_I32 bootstrap
+ begin_av amagic_generation sub_generation address
+- unitcheck_av
++ unitcheck_av isa_generation enable_c3mro disable_c3mro
++ is_c3mro get_linear_isa get_linear_isa_c3 get_linear_isa_dfs
+ )],
+ },
+
+=== ext/B/B.xs
+==================================================================
+--- ext/B/B.xs (/local/perl-current) (revision 12336)
++++ ext/B/B.xs (/local/perl-c3) (revision 12336)
+@@ -604,6 +604,7 @@
+ #define B_main_start() PL_main_start
+ #define B_amagic_generation() PL_amagic_generation
+ #define B_sub_generation() PL_sub_generation
++#define B_isa_generation() PL_isa_generation
+ #define B_defstash() PL_defstash
+ #define B_curstash() PL_curstash
+ #define B_dowarn() PL_dowarn
+@@ -656,6 +657,9 @@
+ long
+ B_sub_generation()
+
++long
++B_isa_generation()
++
+ B::AV
+ B_comppadlist()
+
+@@ -709,6 +713,70 @@
+ OUTPUT:
+ RETVAL
+
++AV*
++get_linear_isa(classname)
++ SV* classname
++ CODE:
++ HV* class_stash;
++ class_stash = gv_stashsv(classname, 0);
++ if(!class_stash) Perl_croak(aTHX_ "No such class!");
++ RETVAL = Perl_linear_isa(class_stash);
++ OUTPUT:
++ RETVAL
++
++AV*
++get_linear_isa_dfs(classname)
++ SV* classname
++ CODE:
++ HV* class_stash;
++ class_stash = gv_stashsv(classname, 0);
++ if(!class_stash) Perl_croak(aTHX_ "No such class!");
++ RETVAL = Perl_linear_isa_dfs(class_stash, 0);
++ OUTPUT:
++ RETVAL
++
++AV*
++get_linear_isa_c3(classname)
++ SV* classname
++ CODE:
++ HV* class_stash;
++ class_stash = gv_stashsv(classname, 0);
++ if(!class_stash) Perl_croak(aTHX_ "No such class!");
++ RETVAL = Perl_linear_isa_c3(class_stash);
++ OUTPUT:
++ RETVAL
++
++void
++enable_c3mro(classname)
++ SV* classname
++ CODE:
++ HV* class_stash;
++ class_stash = gv_stashsv(classname, 1);
++ if(!class_stash) Perl_croak(aTHX_ "Cannot create class!");
++ HvAUX(class_stash)->xhv_c3mro = TRUE;
++ PL_sub_generation++;
++
++void
++disable_c3mro(classname)
++ SV* classname
++ CODE:
++ HV* class_stash;
++ class_stash = gv_stashsv(classname, 1);
++ if(!class_stash) Perl_croak(aTHX_ "Cannot create class!");
++ HvAUX(class_stash)->xhv_c3mro = FALSE;
++ PL_sub_generation++;
++
++bool
++is_c3mro(classname)
++ SV* classname
++ CODE:
++ HV* class_stash;
++ class_stash = gv_stashsv(classname, 0);
++ if(!class_stash) Perl_croak(aTHX_ "No such class!");
++ RETVAL = HvC3MRO(class_stash);
++ OUTPUT:
++ RETVAL
++
+ #define address(sv) PTR2IV(sv)
+
+ IV
+=== ext/B/B.pm
+==================================================================
+--- ext/B/B.pm (/local/perl-current) (revision 12336)
++++ ext/B/B.pm (/local/perl-c3) (revision 12336)
+@@ -23,6 +23,8 @@
+ parents comppadlist sv_undef compile_stats timing_info
+ begin_av init_av unitcheck_av check_av end_av regex_padav
+ dowarn defstash curstash warnhook diehook inc_gv
++ isa_generation enable_c3mro disable_c3mro is_c3mro
++ get_linear_isa get_linear_isa_c3 get_linear_isa_dfs
+ );
+
+ sub OPf_KIDS ();
+=== hv.c
+==================================================================
+--- hv.c (/local/perl-current) (revision 12336)
++++ hv.c (/local/perl-c3) (revision 12336)
+@@ -1895,6 +1895,11 @@
+ iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
+ iter->xhv_name = 0;
+ iter->xhv_backreferences = 0;
++ iter->xhv_dfs_linear_isa = NULL;
++ iter->xhv_dfs_isa_gen = 0;
++ iter->xhv_c3_linear_isa = NULL;
++ iter->xhv_c3_isa_gen = 0;
++ iter->xhv_c3mro = 0;
+ return iter;
+ }
+
+=== hv.h
+==================================================================
+--- hv.h (/local/perl-current) (revision 12336)
++++ hv.h (/local/perl-c3) (revision 12336)
+@@ -44,6 +44,11 @@
+ AV *xhv_backreferences; /* back references for weak references */
+ HE *xhv_eiter; /* current entry of iterator */
+ I32 xhv_riter; /* current root of iterator */
++ AV *xhv_dfs_linear_isa; /* cached dfs @ISA linearization */
++ AV *xhv_c3_linear_isa; /* cached c3 @ISA linearization */
++ U32 xhv_dfs_isa_gen; /* PL_isa_generation for above */
++ U32 xhv_c3_isa_gen; /* PL_isa_generation for above */
++ bool xhv_c3mro; /* use c3 mro for this class */
+ };
+
+ /* hash structure: */
+@@ -235,6 +240,7 @@
+ #define HvRITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_riter : -1)
+ #define HvEITER_get(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_eiter : 0)
+ #define HvNAME(hv) HvNAME_get(hv)
++#define HvC3MRO(hv) (SvOOK(hv) ? HvAUX(hv)->xhv_c3mro : 0)
+ /* FIXME - all of these should use a UTF8 aware API, which should also involve
+ getting the length. */
+ /* This macro may go away without notice. */
+=== mg.c
+==================================================================
+--- mg.c (/local/perl-current) (revision 12336)
++++ mg.c (/local/perl-c3) (revision 12336)
+@@ -1511,6 +1511,7 @@
+ PERL_UNUSED_ARG(sv);
+ PERL_UNUSED_ARG(mg);
+ PL_sub_generation++;
++ PL_isa_generation++;
+ return 0;
+ }
+
+=== intrpvar.h
+==================================================================
+--- intrpvar.h (/local/perl-current) (revision 12336)
++++ intrpvar.h (/local/perl-c3) (revision 12336)
+@@ -560,6 +560,7 @@
+ PERLVARI(Iutf8cache, I8, 1) /* Is the utf8 caching code enabled? */
+ #endif
+
++PERLVARI(Iisa_generation,U32,1) /* incr to invalidate @ISA linearization cache */
+ /* New variables must be added to the very end, before this comment,
+ * for binary compatibility (the offsets of the old members must not change).
+ * (Don't forget to add your variable also to perl_clone()!)
+=== sv.c
+==================================================================
+--- sv.c (/local/perl-current) (revision 12336)
++++ sv.c (/local/perl-c3) (revision 12336)
+@@ -10983,6 +10983,7 @@
+ PL_initav = av_dup_inc(proto_perl->Iinitav, param);
+
+ PL_sub_generation = proto_perl->Isub_generation;
++ PL_isa_generation = proto_perl->Iisa_generation;
+
+ /* funky return mechanisms */
+ PL_forkprocess = proto_perl->Iforkprocess;
+=== embed.fnc
+==================================================================
+--- embed.fnc (/local/perl-current) (revision 12336)
++++ embed.fnc (/local/perl-c3) (revision 12336)
+@@ -278,6 +278,9 @@
+ Apmb |void |gv_efullname3 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix
+ Ap |void |gv_efullname4 |NN SV* sv|NN const GV* gv|NULLOK const char* prefix|bool keepmain
+ Ap |GV* |gv_fetchfile |NN const char* name
++pM |AV* |linear_isa |NN HV* stash
++pM |AV* |linear_isa_c3 |NN HV* stash
++pM |AV* |linear_isa_dfs |NN HV* stash|I32 level
+ Apd |GV* |gv_fetchmeth |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level
+ Apd |GV* |gv_fetchmeth_autoload |NULLOK HV* stash|NN const char* name|STRLEN len|I32 level
+ Apdmb |GV* |gv_fetchmethod |NULLOK HV* stash|NN const char* name
+
+Property changes on:
+___________________________________________________________________
+Name: svk:merge
+ +2679d79f-d018-0410-a353-0f906ad2929c:/local/perl-current:12331
+
projects / gitmo/Class-C3.git / commitdiff