This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Move super cache into mro meta
authorFather Chrysostomos <sprout@cpan.org>
Sun, 18 Aug 2013 07:36:05 +0000 (00:36 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Wed, 21 Aug 2013 04:38:07 +0000 (21:38 -0700)
Iterated hashes shouldn’t have to allocate space for something
specific to stashes, so move the SUPER method cache from the
HvAUX struct (which all iterated hashes have) into the mro
meta struct (which only stashes have).

gv.c
hv.c
hv.h
mro.c
sv.c

diff --git a/gv.c b/gv.c
index 13bcbbf..5702e5e 100644 (file)
--- a/gv.c
+++ b/gv.c
@@ -681,8 +681,9 @@ Perl_gv_fetchmeth_pvn(pTHX_ HV *stash, const char *name, STRLEN len, I32 level,
     topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
     if (flags & GV_SUPER) {
-       if (!HvAUX(stash)->xhv_super) HvAUX(stash)->xhv_super = newHV();
-       cachestash = HvAUX(stash)->xhv_super;
+       if (!HvAUX(stash)->xhv_mro_meta->super)
+           HvAUX(stash)->xhv_mro_meta->super = newHV();
+       cachestash = HvAUX(stash)->xhv_mro_meta->super;
     }
     else cachestash = stash;
 
diff --git a/hv.c b/hv.c
index 02fe607..07837ab 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1827,10 +1827,10 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
            SvREFCNT_dec(meta->mro_linear_current);
        SvREFCNT_dec(meta->mro_nextmethod);
        SvREFCNT_dec(meta->isa);
+       SvREFCNT_dec(meta->super);
        Safefree(meta);
        aux->xhv_mro_meta = NULL;
       }
-      SvREFCNT_dec(aux->xhv_super);
       if (!aux->xhv_name_u.xhvnameu_name && ! aux->xhv_backreferences)
        SvFLAGS(hv) &= ~SVf_OOK;
     }
@@ -1982,7 +1982,6 @@ S_hv_auxinit(pTHX_ HV *hv) {
     iter->xhv_name_count = 0;
     iter->xhv_backreferences = 0;
     iter->xhv_mro_meta = NULL;
-    iter->xhv_super = NULL;
     return iter;
 }
 
diff --git a/hv.h b/hv.h
index 47432e3..920fd99 100644 (file)
--- a/hv.h
+++ b/hv.h
@@ -81,6 +81,7 @@ struct mro_meta {
     U32     pkg_gen;         /* Bumps when local methods/@ISA change */
     const struct mro_alg *mro_which; /* which mro alg is in use? */
     HV      *isa;            /* Everything this class @ISA */
+    HV      *super;          /* SUPER method cache */
     U32     destroy_gen;     /* Generation number of DESTROY cache */
 };
 
@@ -112,7 +113,6 @@ struct xpvhv_aux {
  */
     I32                xhv_name_count;
     struct mro_meta *xhv_mro_meta;
-    HV *       xhv_super;      /* SUPER method cache */
 #ifdef PERL_HASH_RANDOMIZE_KEYS
     U32         xhv_rand;       /* random value for hash traversal */
     U32         xhv_last_rand;  /* last random value for hash traversal,
diff --git a/mro.c b/mro.c
index cb67950..2ce9fa2 100644 (file)
--- a/mro.c
+++ b/mro.c
@@ -186,6 +186,8 @@ Perl_mro_meta_dup(pTHX_ struct mro_meta* smeta, CLONE_PARAMS* param)
        newmeta->isa
            = MUTABLE_HV(sv_dup_inc((const SV *)newmeta->isa, param));
 
+    newmeta->super = NULL;
+
     return newmeta;
 }
 
diff --git a/sv.c b/sv.c
index ea96a04..6b858de 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -12518,7 +12518,6 @@ S_sv_dup_common(pTHX_ const SV *const sstr, CLONE_PARAMS *const param)
                         daux->xhv_mro_meta = saux->xhv_mro_meta
                             ? mro_meta_dup(saux->xhv_mro_meta, param)
                             : 0;
-                       daux->xhv_super = NULL;
 
                        /* Record stashes for possible cloning in Perl_clone(). */
                        if (HvNAME(sstr))