Skip to content

Commit

Permalink
Re: mro status, etc
Browse files Browse the repository at this point in the history
From: "Brandon Black" <blblack@gmail.com>
Message-ID: <84621a60704291527y1b39be37l221ef66e4c828f66@mail.gmail.com>

p4raw-id: //depot/perl@31107
  • Loading branch information
blblack authored and rgs committed Apr 30, 2007
1 parent 49d7dfb commit dd69841
Show file tree
Hide file tree
Showing 21 changed files with 268 additions and 200 deletions.
2 changes: 2 additions & 0 deletions embedvar.h
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down
31 changes: 4 additions & 27 deletions gv.c
Original file line number Diff line number Diff line change
Expand Up @@ -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);
Expand Down Expand Up @@ -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);
Expand Down Expand Up @@ -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;
}
Expand All @@ -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;
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) {
Expand Down
9 changes: 7 additions & 2 deletions hv.c
Original file line number Diff line number Diff line change
Expand Up @@ -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);
}
}
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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);
Expand Down
16 changes: 5 additions & 11 deletions hv.h
Original file line number Diff line number Diff line change
Expand Up @@ -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.
Expand Down
2 changes: 2 additions & 0 deletions intrpvar.h
Original file line number Diff line number Diff line change
Expand Up @@ -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. */

Expand Down
14 changes: 0 additions & 14 deletions lib/mro.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions mg.c
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand Down
Loading

0 comments on commit dd69841

Please sign in to comment.