Permalink
Browse files

Re: mro status, etc

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

p4raw-id: //depot/perl@31107
  • Loading branch information...
1 parent 49d7dfb commit dd69841bebe1fc7f7a6b248576221520a0418d52 @blblack blblack committed with rgs Apr 29, 2007
Showing with 268 additions and 200 deletions.
  1. +2 −0 embedvar.h
  2. +4 −27 gv.c
  3. +7 −2 hv.c
  4. +5 −11 hv.h
  5. +2 −0 intrpvar.h
  6. +0 −14 lib/mro.pm
  7. +2 −0 mg.c
  8. +79 −104 mro.c
  9. +0 −4 op.c
  10. +4 −0 perl.c
  11. +2 −0 perlapi.h
  12. +19 −14 pod/perlapi.pod
  13. +4 −4 pod/perlboot.pod
  14. +3 −2 pod/perlobj.pod
  15. +62 −1 pod/perltoot.pod
  16. +9 −0 pp.c
  17. +1 −1 pp_hot.c
  18. +3 −2 scope.c
  19. +34 −5 sv.c
  20. +25 −8 t/mro/method_caching.t
  21. +1 −1 universal.c
View
@@ -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
View
31 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) {
View
9 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);
View
16 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.
View
@@ -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. */
View
@@ -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
View
2 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)) {
Oops, something went wrong.

0 comments on commit dd69841

Please sign in to comment.