/*
=for apidoc mro_isa_changed_in
Takes the necessary steps (cache invalidations, mostly)
when the @ISA of the given package has changed. Invoked
by the C<setisa> magic, should not need to invoke directly.
=cut
*/
void
Perl_mro_isa_changed_in(pTHX_ HV* stash)
{
dVAR;
HV* isarev;
AV* linear_mro;
HE* iter;
SV** svp;
I32 items;
bool is_universal;
struct mro_meta * meta;
const char * const stashname = HvNAME_get(stash);
const STRLEN stashname_len = HvNAMELEN_get(stash);
PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
/* wipe out the cached linearizations for this stash */
meta = HvMROMETA(stash);
if (meta->mro_linear_dfs) {
SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_dfs));
meta->mro_linear_dfs = NULL;
/* This is just acting as a shortcut pointer. */
meta->mro_linear_c3 = NULL;
} else if (meta->mro_linear_c3) {
/* Only the current MRO is stored, so this owns the data. */
SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_c3));
meta->mro_linear_c3 = NULL;
}
if (meta->isa) {
SvREFCNT_dec(meta->isa);
meta->isa = NULL;
}
/* Inc the package generation, since our @ISA changed */
meta->pkg_gen++;
/* Wipe the global method cache if this package
is UNIVERSAL or one of its parents */
svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
isarev = svp ? MUTABLE_HV(*svp) : NULL;
if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
|| (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
PL_sub_generation++;
is_universal = TRUE;
}
else { /* Wipe the local method cache otherwise */
meta->cache_gen++;
is_universal = FALSE;
}
/* wipe next::method cache too */
if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
/* Iterate the isarev (classes that are our children),
wiping out their linearization, method and isa caches */
if(isarev) {
hv_iterinit(isarev);
while((iter = hv_iternext(isarev))) {
I32 len;
const char* const revkey = hv_iterkey(iter, &len);
HV* revstash = gv_stashpvn(revkey, len, 0);
struct mro_meta* revmeta;
if(!revstash) continue;
revmeta = HvMROMETA(revstash);
if (revmeta->mro_linear_dfs) {
SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_dfs));
revmeta->mro_linear_dfs = NULL;
/* This is just acting as a shortcut pointer. */
revmeta->mro_linear_c3 = NULL;
} else if (revmeta->mro_linear_c3) {
/* Only the current MRO is stored, so this owns the data. */
SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_c3));
revmeta->mro_linear_c3 = NULL;
}
if(!is_universal)
revmeta->cache_gen++;
if(revmeta->mro_nextmethod)
hv_clear(revmeta->mro_nextmethod);
if (revmeta->isa) {
SvREFCNT_dec(revmeta->isa);
revmeta->isa = NULL;
}
}
}
/* Now iterate our MRO (parents), and do a few things:
1) instantiate with the "fake" flag if they don't exist
2) flag them as universal if we are universal
3) Add everything from our isarev to their isarev
*/
/* We're starting at the 2nd element, skipping ourselves here */
linear_mro = mro_get_linear_isa(stash);
svp = AvARRAY(linear_mro) + 1;
items = AvFILLp(linear_mro);
while (items--) {
SV* const sv = *svp++;
HV* mroisarev;
HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
/* That fetch should not fail. But if it had to create a new SV for
us, then we can detect it, because it will not be the correct type.
Probably faster and cleaner for us to free that scalar [very little
code actually executed to free it] and create a new HV than to
copy&paste [SIN!] the code from newHV() to allow us to upgrade the
new SV from SVt_NULL. */
mroisarev = MUTABLE_HV(HeVAL(he));
if(SvTYPE(mroisarev) != SVt_PVHV) {
SvREFCNT_dec(mroisarev);
mroisarev = newHV();
HeVAL(he) = MUTABLE_SV(mroisarev);
}
/* This hash only ever contains PL_sv_yes. Storing it over itself is
almost as cheap as calling hv_exists, so on aggregate we expect to
save time by not making two calls to the common HV code for the
case where it doesn't exist. */
(void)hv_store(mroisarev, stashname, stashname_len, &PL_sv_yes, 0);
if(isarev) {
hv_iterinit(isarev);
while((iter = hv_iternext(isarev))) {
I32 revkeylen;
char* const revkey = hv_iterkey(iter, &revkeylen);
(void)hv_store(mroisarev, revkey, revkeylen, &PL_sv_yes, 0);
}
}
}
}
void
Perl_mro_isa_changed_in(pTHX_ HV* stash)
{
HV* isarev;
AV* linear_mro;
HE* iter;
SV** svp;
I32 items;
bool is_universal;
struct mro_meta * meta;
HV *isa = NULL;
const HEK * const stashhek = HvENAME_HEK(stash);
const char * const stashname = HvENAME_get(stash);
const STRLEN stashname_len = HvENAMELEN_get(stash);
PERL_ARGS_ASSERT_MRO_ISA_CHANGED_IN;
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_isa_changed_in() on anonymous symbol table");
/* wipe out the cached linearizations for this stash */
meta = HvMROMETA(stash);
CLEAR_LINEAR(meta);
if (meta->isa) {
/* Steal it for our own purposes. */
isa = (HV *)sv_2mortal((SV *)meta->isa);
meta->isa = NULL;
}
/* Inc the package generation, since our @ISA changed */
meta->pkg_gen++;
/* Wipe the global method cache if this package
is UNIVERSAL or one of its parents */
svp = hv_fetchhek(PL_isarev, stashhek, 0);
isarev = svp ? MUTABLE_HV(*svp) : NULL;
if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
|| (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
PL_sub_generation++;
is_universal = TRUE;
}
else { /* Wipe the local method cache otherwise */
meta->cache_gen++;
is_universal = FALSE;
}
/* wipe next::method cache too */
if(meta->mro_nextmethod) hv_clear(meta->mro_nextmethod);
/* Changes to @ISA might turn overloading on */
HvAMAGIC_on(stash);
/* pessimise derefs for now. Will get recalculated by Gv_AMupdate() */
HvAUX(stash)->xhv_aux_flags &= ~HvAUXf_NO_DEREF;
/* DESTROY can be cached in SvSTASH. */
if (!SvOBJECT(stash)) SvSTASH(stash) = NULL;
/* Iterate the isarev (classes that are our children),
wiping out their linearization, method and isa caches
and upating PL_isarev. */
if(isarev) {
HV *isa_hashes = NULL;
/* We have to iterate through isarev twice to avoid a chicken and
* egg problem: if A inherits from B and both are in isarev, A might
* be processed before B and use B's previous linearisation.
*/
/* First iteration: Wipe everything, but stash away the isa hashes
* since we still need them for updating PL_isarev.
*/
if(hv_iterinit(isarev)) {
/* Only create the hash if we need it; i.e., if isarev has
any elements. */
isa_hashes = (HV *)sv_2mortal((SV *)newHV());
}
while((iter = hv_iternext(isarev))) {
HV* revstash = gv_stashsv(hv_iterkeysv(iter), 0);
struct mro_meta* revmeta;
if(!revstash) continue;
revmeta = HvMROMETA(revstash);
CLEAR_LINEAR(revmeta);
if(!is_universal)
revmeta->cache_gen++;
if(revmeta->mro_nextmethod)
hv_clear(revmeta->mro_nextmethod);
if (!SvOBJECT(revstash)) SvSTASH(revstash) = NULL;
(void)
hv_store(
isa_hashes, (const char*)&revstash, sizeof(HV *),
revmeta->isa ? (SV *)revmeta->isa : &PL_sv_undef, 0
);
revmeta->isa = NULL;
}
/* Second pass: Update PL_isarev. We can just use isa_hashes to
* avoid another round of stash lookups. */
/* isarev might be deleted from PL_isarev during this loop, so hang
* on to it. */
SvREFCNT_inc_simple_void_NN(sv_2mortal((SV *)isarev));
if(isa_hashes) {
hv_iterinit(isa_hashes);
while((iter = hv_iternext(isa_hashes))) {
HV* const revstash = *(HV **)HEK_KEY(HeKEY_hek(iter));
HV * const isa = (HV *)HeVAL(iter);
const HEK *namehek;
/* We're starting at the 2nd element, skipping revstash */
linear_mro = mro_get_linear_isa(revstash);
svp = AvARRAY(linear_mro) + 1;
items = AvFILLp(linear_mro);
namehek = HvENAME_HEK(revstash);
if (!namehek) namehek = HvNAME_HEK(revstash);
while (items--) {
SV* const sv = *svp++;
HV* mroisarev;
HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
/* That fetch should not fail. But if it had to create
a new SV for us, then will need to upgrade it to an
HV (which sv_upgrade() can now do for us). */
mroisarev = MUTABLE_HV(HeVAL(he));
SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
/* This hash only ever contains PL_sv_yes. Storing it
over itself is almost as cheap as calling hv_exists,
so on aggregate we expect to save time by not making
two calls to the common HV code for the case where
it doesn't exist. */
(void)
hv_storehek(mroisarev, namehek, &PL_sv_yes);
}
if ((SV *)isa != &PL_sv_undef) {
assert(namehek);
mro_clean_isarev(
isa, HEK_KEY(namehek), HEK_LEN(namehek),
HvMROMETA(revstash)->isa, HEK_HASH(namehek),
HEK_UTF8(namehek)
);
}
}
}
}
/* Now iterate our MRO (parents), adding ourselves and everything from
our isarev to their isarev.
*/
/* We're starting at the 2nd element, skipping ourselves here */
linear_mro = mro_get_linear_isa(stash);
svp = AvARRAY(linear_mro) + 1;
items = AvFILLp(linear_mro);
while (items--) {
SV* const sv = *svp++;
HV* mroisarev;
HE *he = hv_fetch_ent(PL_isarev, sv, TRUE, 0);
/* That fetch should not fail. But if it had to create a new SV for
us, then will need to upgrade it to an HV (which sv_upgrade() can
now do for us. */
mroisarev = MUTABLE_HV(HeVAL(he));
SvUPGRADE(MUTABLE_SV(mroisarev), SVt_PVHV);
/* This hash only ever contains PL_sv_yes. Storing it over itself is
almost as cheap as calling hv_exists, so on aggregate we expect to
save time by not making two calls to the common HV code for the
case where it doesn't exist. */
(void)hv_storehek(mroisarev, stashhek, &PL_sv_yes);
}
/* Delete our name from our former parents' isarevs. */
if(isa && HvARRAY(isa))
mro_clean_isarev(isa, stashname, stashname_len, meta->isa,
HEK_HASH(stashhek), HEK_UTF8(stashhek));
}
