Re: mro status, etc

From: "Brandon Black" <blblack@gmail.com>
Message-ID: <84621a60704291527y1b39be37l221ef66e4c828f66@mail.gmail.com>

p4raw-id: //depot/perl@31107

embedvar.h

@@ -227,6 +227,7 @@
 #define PL_incgv		(vTHX->Iincgv)
 #define PL_initav		(vTHX->Iinitav)
 #define PL_inplace		(vTHX->Iinplace)
+#define PL_isarev		(vTHX->Iisarev)
 #define PL_known_layers		(vTHX->Iknown_layers)
 #define PL_last_lop		(vTHX->Ilast_lop)
 #define PL_last_lop_op		(vTHX->Ilast_lop_op)
@@ -491,6 +492,7 @@
 #define PL_Iincgv		PL_incgv
 #define PL_Iinitav		PL_initav
 #define PL_Iinplace		PL_inplace
+#define PL_Iisarev		PL_isarev
 #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

@@ -360,7 +360,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
 
     DEBUG_o( Perl_deb(aTHX_ "Looking for method %s in package %s\n",name,hvname) );
 
-    topgen_cmp = HvMROMETA(stash)->sub_generation + PL_sub_generation;
+    topgen_cmp = HvMROMETA(stash)->cache_gen + PL_sub_generation;
 
     /* check locally for a real method or a cache entry */
     gvp = (GV**)hv_fetch(stash, name, len, create);
@@ -405,17 +405,7 @@ Perl_gv_fetchmeth(pTHX_ HV *stash, const char *name, STRLEN len, I32 level)
         assert(linear_sv);
         cstash = gv_stashsv(linear_sv, 0);
 
-        /* mg.c:Perl_magic_setisa sets the fake flag on packages it had
-           to create that the user did not.  The "package" statement
-           clears it.  We also check if there's anything in the symbol
-           table at all, which would indicate a previously "fake" package
-           where someone adding things via $Foo::Bar = 1 without ever
-           using a "package" statement.
-           This was all neccesary because magic_setisa needs a place to
-           keep isarev information on packages that aren't yet defined,
-           yet we still need to issue this warning when appropriate.
-        */
-        if (!cstash || (HvMROMETA(cstash)->fake && !HvFILL(cstash))) {
+        if (!cstash) {
             if (ckWARN(WARN_SYNTAX))
                 Perl_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %"SVf" for @%s::ISA",
                     SVfARG(linear_sv), hvname);
@@ -1445,15 +1435,6 @@ Perl_gp_ref(pTHX_ GP *gp)
 	    gp->gp_cv = NULL;
 	    gp->gp_cvgen = 0;
 	}
-        /* XXX if anyone finds a method cache regression with
-           the "mro" stuff, turning this else block back on
-           is probably the first place to look --blblack
-        */
-        /*
-        else {
-            PL_sub_generation++;
-        }
-        */
     }
     return gp;
 }
@@ -1473,10 +1454,6 @@ Perl_gp_free(pTHX_ GV *gv)
                         pTHX__FORMAT pTHX__VALUE);
         return;
     }
-    if (gp->gp_cv) {
-	/* Deleting the name of a subroutine invalidates method cache */
-	PL_sub_generation++;
-    }
     if (--gp->gp_refcnt > 0) {
 	if (gp->gp_egv == gv)
 	    gp->gp_egv = 0;
@@ -1534,7 +1511,7 @@ Perl_Gv_AMupdate(pTHX_ HV *stash)
   AMT amt;
   U32 newgen;
 
-  newgen = PL_sub_generation + HvMROMETA(stash)->sub_generation;
+  newgen = PL_sub_generation + HvMROMETA(stash)->cache_gen;
   if (mg) {
       const AMT * const amtp = (AMT*)mg->mg_ptr;
       if (amtp->was_ok_am == PL_amagic_generation
@@ -1665,7 +1642,7 @@ Perl_gv_handler(pTHX_ HV *stash, I32 id)
     if (!stash || !HvNAME_get(stash))
         return NULL;
 
-    newgen = PL_sub_generation + HvMROMETA(stash)->sub_generation;
+    newgen = PL_sub_generation + HvMROMETA(stash)->cache_gen;
 
     mg = mg_find((SV*)stash, PERL_MAGIC_overload_table);
     if (!mg) {

hv.c

@@ -1608,6 +1608,8 @@ Perl_hv_clear(pTHX_ HV *hv)
     HvREHASH_off(hv);
     reset:
     if (SvOOK(hv)) {
+        if(HvNAME_get(hv))
+            mro_isa_changed_in(hv);
 	HvEITER_set(hv, NULL);
     }
 }
@@ -1756,7 +1758,6 @@ S_hfreeentries(pTHX_ HV *hv)
             if((meta = iter->xhv_mro_meta)) {
                 if(meta->mro_linear_dfs) SvREFCNT_dec(meta->mro_linear_dfs);
                 if(meta->mro_linear_c3)  SvREFCNT_dec(meta->mro_linear_c3);
-                if(meta->mro_isarev)     SvREFCNT_dec(meta->mro_isarev);
                 if(meta->mro_nextmethod) SvREFCNT_dec(meta->mro_nextmethod);
                 Safefree(meta);
                 iter->xhv_mro_meta = NULL;
@@ -1845,8 +1846,12 @@ Perl_hv_undef(pTHX_ HV *hv)
 	return;
     DEBUG_A(Perl_hv_assert(aTHX_ hv));
     xhv = (XPVHV*)SvANY(hv);
+
+    if ((name = HvNAME_get(hv)) && !PL_dirty)
+        mro_isa_changed_in(hv);
+
     hfreeentries(hv);
-    if ((name = HvNAME_get(hv))) {
+    if (name) {
         if(PL_stashcache)
 	    hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
 	hv_name_set(hv, NULL, 0, 0);

hv.h

@@ -47,17 +47,11 @@ typedef enum {
 } mro_alg;
 
 struct mro_meta {
-    AV          *mro_linear_dfs; /* cached dfs @ISA linearization */
-    AV          *mro_linear_c3; /* cached c3 @ISA linearization */
-    HV		*mro_isarev;    /* reverse @ISA dependencies (who depends on us?) */
-    HV		*mro_nextmethod; /* next::method caching */
-    U32		sub_generation; /* Like PL_sub_generation, but stash-local */
-    mro_alg	mro_which;      /* which mro alg is in use? */
-    unsigned int is_universal : 1;  /* We are UNIVERSAL or a potentially
-				       indirect member of @UNIVERSAL::ISA */
-    unsigned int fake : 1;          /* setisa made this fake package,
-				       gv_fetchmeth pays attention to this,
-				       and "package" sets it back to zero */
+    AV      *mro_linear_dfs; /* cached dfs @ISA linearization */
+    AV      *mro_linear_c3;  /* cached c3 @ISA linearization */
+    HV      *mro_nextmethod; /* next::method caching */
+    U32     cache_gen;       /* Bumping this invalidates our method cache */
+    mro_alg mro_which;       /* which mro alg is in use? */
 };
 
 /* Subject to change.

intrpvar.h

@@ -535,6 +535,8 @@ PERLVARI(Islabs, I32**, NULL)	/* Array of slabs that have been allocated */
 PERLVARI(Islab_count, U32, 0)	/* Size of the array */
 #endif
 
+PERLVARI(Iisarev, HV*, NULL) /* Reverse map of @ISA dependencies */
+
 /* If you are adding a U16, see the comment above on where there are 2 bytes
    of gap which currently will be structure padding.  */
 

lib/mro.pm

@@ -141,25 +141,11 @@ For similar reasons to C<isarev> above, this flag is
 permanent.  Once it is set, it does not go away, even
 if the class in question really isn't universal anymore.
 
-=head2 mro::get_global_sub_generation()
-
-Returns the current value of the internal perl variable
-C<PL_sub_generation>.
-
 =head2 mro::invalidate_all_method_caches()
 
 Increments C<PL_sub_generation>, which invalidates method
 caching in all packages.
 
-=head2 mro::get_sub_generation($classname)
-
-Returns the current value of a given package's C<sub_generation>.
-This is only incremented when necessary for that package.
-
-If one is trying to determine whether significant (method/cache-affecting)
-changes have occured for a given stash since you last checked, you should
-check both this and the global one above.
-
 =head2 mro::method_changed_in($classname)
 
 Invalidates the method cache of any classes dependent on the

mg.c

@@ -1925,6 +1925,8 @@ Perl_magic_setglob(pTHX_ SV *sv, MAGIC *mg)
     GV* gv;
     PERL_UNUSED_ARG(mg);
 
+    Perl_croak(aTHX_ "Perl_magic_setglob is dead code?");
+
     if (!SvOK(sv))
 	return 0;
     if (isGV_with_GP(sv)) {