SV **data;
PERL_ARGS_ASSERT_MRO_GET_PRIVATE_DATA;
- data = Perl_hv_common(aTHX_ MUTABLE_HV(smeta->mro_linear_dfs), NULL,
+ data = Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL,
which->name, which->length, which->kflags,
HV_FETCH_JUST_SV, NULL, which->hash);
if (!data)
/* If we've been asked to look up the private data for the current MRO, then
cache it. */
if (smeta->mro_which == which)
- smeta->mro_linear_c3 = MUTABLE_AV(*data);
+ smeta->mro_linear_current = *data;
return *data;
}
{
PERL_ARGS_ASSERT_MRO_SET_PRIVATE_DATA;
- if (!smeta->mro_linear_dfs) {
+ if (!smeta->mro_linear_all) {
if (smeta->mro_which == which) {
/* If all we need to store is the current MRO's data, then don't use
memory on a hash with 1 element - store it direct, and signal
this by leaving the would-be-hash NULL. */
- smeta->mro_linear_c3 = MUTABLE_AV(data);
+ smeta->mro_linear_current = data;
return data;
} else {
HV *const hv = newHV();
/* Start with 2 buckets. It's unlikely we'll need more. */
HvMAX(hv) = 1;
- smeta->mro_linear_dfs = MUTABLE_AV(hv);
+ smeta->mro_linear_all = hv;
- if (smeta->mro_linear_c3) {
+ if (smeta->mro_linear_current) {
/* If we were storing something directly, put it in the hash
before we lose it. */
Perl_mro_set_private_data(aTHX_ smeta, smeta->mro_which,
- MUTABLE_SV(smeta->mro_linear_c3));
+ smeta->mro_linear_current);
}
}
}
if (smeta->mro_which == which) {
/* If we've been asked to store the private data for the current MRO,
then cache it. */
- smeta->mro_linear_c3 = MUTABLE_AV(data);
+ smeta->mro_linear_current = data;
}
- if (!Perl_hv_common(aTHX_ MUTABLE_HV(smeta->mro_linear_dfs), NULL,
+ if (!Perl_hv_common(aTHX_ smeta->mro_linear_all, NULL,
which->name, which->length, which->kflags,
HV_FETCH_ISSTORE, data, which->hash)) {
Perl_croak(aTHX_ "panic: hv_store() failed in set_mro_private_data() "
Newx(newmeta, 1, struct mro_meta);
Copy(smeta, newmeta, 1, struct mro_meta);
- if (newmeta->mro_linear_dfs) {
- newmeta->mro_linear_dfs
- = MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_dfs, param)));
+ if (newmeta->mro_linear_all) {
+ newmeta->mro_linear_all
+ = MUTABLE_HV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_all, param)));
/* This is just acting as a shortcut pointer, and will be automatically
updated on the first get. */
- newmeta->mro_linear_c3 = NULL;
- } else if (newmeta->mro_linear_c3) {
+ newmeta->mro_linear_current = NULL;
+ } else if (newmeta->mro_linear_current) {
/* Only the current MRO is stored, so this owns the data. */
- newmeta->mro_linear_c3
- = MUTABLE_AV(SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_c3, param)));
+ newmeta->mro_linear_current
+ = SvREFCNT_inc(sv_dup((const SV *)newmeta->mro_linear_current,
+ param));
}
if (newmeta->mro_nextmethod)
/* 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;
+ if (meta->mro_linear_all) {
+ SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_all));
+ meta->mro_linear_all = NULL;
/* This is just acting as a shortcut pointer. */
- meta->mro_linear_c3 = NULL;
- } else if (meta->mro_linear_c3) {
+ meta->mro_linear_current = NULL;
+ } else if (meta->mro_linear_current) {
/* Only the current MRO is stored, so this owns the data. */
- SvREFCNT_dec(MUTABLE_SV(meta->mro_linear_c3));
- meta->mro_linear_c3 = NULL;
+ SvREFCNT_dec(meta->mro_linear_current);
+ meta->mro_linear_current = NULL;
}
if (meta->isa) {
SvREFCNT_dec(meta->isa);
if(!revstash) continue;
revmeta = HvMROMETA(revstash);
- if (revmeta->mro_linear_dfs) {
- SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_dfs));
- revmeta->mro_linear_dfs = NULL;
+ if (revmeta->mro_linear_all) {
+ SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_all));
+ revmeta->mro_linear_all = NULL;
/* This is just acting as a shortcut pointer. */
- revmeta->mro_linear_c3 = NULL;
- } else if (revmeta->mro_linear_c3) {
+ revmeta->mro_linear_current = NULL;
+ } else if (revmeta->mro_linear_current) {
/* Only the current MRO is stored, so this owns the data. */
- SvREFCNT_dec(MUTABLE_SV(revmeta->mro_linear_c3));
- revmeta->mro_linear_c3 = NULL;
+ SvREFCNT_dec(revmeta->mro_linear_current);
+ revmeta->mro_linear_current = NULL;
}
if(!is_universal)
revmeta->cache_gen++;
}
}
-#include "XSUB.h"
-
-XS(XS_mro_get_linear_isa);
-XS(XS_mro_set_mro);
-XS(XS_mro_get_mro);
-XS(XS_mro_get_isarev);
-XS(XS_mro_is_universal);
-XS(XS_mro_invalidate_method_caches);
-XS(XS_mro_method_changed_in);
-XS(XS_mro_get_pkg_gen);
-
void
-Perl_boot_core_mro(pTHX)
-{
- dVAR;
- static const char file[] = __FILE__;
-
- Perl_mro_register(aTHX_ &dfs_alg);
-
- newXSproto("mro::get_linear_isa", XS_mro_get_linear_isa, file, "$;$");
- newXSproto("mro::set_mro", XS_mro_set_mro, file, "$$");
- newXSproto("mro::get_mro", XS_mro_get_mro, file, "$");
- newXSproto("mro::get_isarev", XS_mro_get_isarev, file, "$");
- newXSproto("mro::is_universal", XS_mro_is_universal, file, "$");
- newXSproto("mro::invalidate_all_method_caches", XS_mro_invalidate_method_caches, file, "");
- newXSproto("mro::method_changed_in", XS_mro_method_changed_in, file, "$");
- newXSproto("mro::get_pkg_gen", XS_mro_get_pkg_gen, file, "$");
-}
-
-XS(XS_mro_get_linear_isa) {
- dVAR;
- dXSARGS;
- AV* RETVAL;
- HV* class_stash;
- SV* classname;
-
- if(items < 1 || items > 2)
- croak_xs_usage(cv, "classname [, type ]");
-
- classname = ST(0);
- class_stash = gv_stashsv(classname, 0);
-
- if(!class_stash) {
- /* No stash exists yet, give them just the classname */
- AV* isalin = newAV();
- av_push(isalin, newSVsv(classname));
- ST(0) = sv_2mortal(newRV_noinc(MUTABLE_SV(isalin)));
- XSRETURN(1);
- }
- else if(items > 1) {
- const struct mro_alg *const algo = Perl_mro_get_from_name(aTHX_ ST(1));
- if (!algo)
- Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));
- RETVAL = algo->resolve(aTHX_ class_stash, 0);
- }
- else {
- RETVAL = mro_get_linear_isa(class_stash);
- }
-
- ST(0) = newRV_inc(MUTABLE_SV(RETVAL));
- sv_2mortal(ST(0));
- XSRETURN(1);
-}
-
-XS(XS_mro_set_mro)
+Perl_mro_set_mro(pTHX_ struct mro_meta *const meta, SV *const name)
{
- dVAR;
- dXSARGS;
- SV* classname;
- const struct mro_alg *which;
- HV* class_stash;
- struct mro_meta* meta;
-
- if (items != 2)
- croak_xs_usage(cv, "classname, type");
+ const struct mro_alg *const which = Perl_mro_get_from_name(aTHX_ name);
+
+ PERL_ARGS_ASSERT_MRO_SET_MRO;
- classname = ST(0);
- class_stash = gv_stashsv(classname, GV_ADD);
- if(!class_stash) Perl_croak(aTHX_ "Cannot create class: '%"SVf"'!", SVfARG(classname));
- meta = HvMROMETA(class_stash);
-
- which = Perl_mro_get_from_name(aTHX_ ST(1));
if (!which)
- Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", ST(1));
+ Perl_croak(aTHX_ "Invalid mro name: '%"SVf"'", name);
if(meta->mro_which != which) {
- if (meta->mro_linear_c3 && !meta->mro_linear_dfs) {
+ if (meta->mro_linear_current && !meta->mro_linear_all) {
/* If we were storing something directly, put it in the hash before
we lose it. */
Perl_mro_set_private_data(aTHX_ meta, meta->mro_which,
- MUTABLE_SV(meta->mro_linear_c3));
+ MUTABLE_SV(meta->mro_linear_current));
}
meta->mro_which = which;
/* Scrub our cached pointer to the private data. */
- meta->mro_linear_c3 = NULL;
+ meta->mro_linear_current = NULL;
/* Only affects local method cache, not
even child classes */
meta->cache_gen++;
if(meta->mro_nextmethod)
hv_clear(meta->mro_nextmethod);
}
-
- XSRETURN_EMPTY;
-}
-
-
-XS(XS_mro_get_mro)
-{
- dVAR;
- dXSARGS;
- SV* classname;
- HV* class_stash;
-
- if (items != 1)
- croak_xs_usage(cv, "classname");
-
- classname = ST(0);
- class_stash = gv_stashsv(classname, 0);
-
- ST(0) = sv_2mortal(newSVpv(class_stash
- ? HvMROMETA(class_stash)->mro_which->name
- : "dfs", 0));
- XSRETURN(1);
}
-XS(XS_mro_get_isarev)
-{
- dVAR;
- dXSARGS;
- SV* classname;
- HE* he;
- HV* isarev;
- AV* ret_array;
-
- if (items != 1)
- croak_xs_usage(cv, "classname");
-
- classname = ST(0);
-
- SP -= items;
-
-
- he = hv_fetch_ent(PL_isarev, classname, 0, 0);
- isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
-
- ret_array = newAV();
- if(isarev) {
- HE* iter;
- hv_iterinit(isarev);
- while((iter = hv_iternext(isarev)))
- av_push(ret_array, newSVsv(hv_iterkeysv(iter)));
- }
- mXPUSHs(newRV_noinc(MUTABLE_SV(ret_array)));
-
- PUTBACK;
- return;
-}
-
-XS(XS_mro_is_universal)
-{
- dVAR;
- dXSARGS;
- SV* classname;
- HV* isarev;
- char* classname_pv;
- STRLEN classname_len;
- HE* he;
-
- if (items != 1)
- croak_xs_usage(cv, "classname");
-
- classname = ST(0);
-
- classname_pv = SvPV(classname,classname_len);
-
- he = hv_fetch_ent(PL_isarev, classname, 0, 0);
- isarev = he ? MUTABLE_HV(HeVAL(he)) : NULL;
+#include "XSUB.h"
- if((classname_len == 9 && strEQ(classname_pv, "UNIVERSAL"))
- || (isarev && hv_exists(isarev, "UNIVERSAL", 9)))
- XSRETURN_YES;
- else
- XSRETURN_NO;
-}
+XS(XS_mro_method_changed_in);
-XS(XS_mro_invalidate_method_caches)
+void
+Perl_boot_core_mro(pTHX)
{
dVAR;
- dXSARGS;
-
- if (items != 0)
- croak_xs_usage(cv, "");
+ static const char file[] = __FILE__;
- PL_sub_generation++;
+ Perl_mro_register(aTHX_ &dfs_alg);
- XSRETURN_EMPTY;
+ newXSproto("mro::method_changed_in", XS_mro_method_changed_in, file, "$");
}
XS(XS_mro_method_changed_in)
XSRETURN_EMPTY;
}
-XS(XS_mro_get_pkg_gen)
-{
- dVAR;
- dXSARGS;
- SV* classname;
- HV* class_stash;
-
- if(items != 1)
- croak_xs_usage(cv, "classname");
-
- classname = ST(0);
-
- class_stash = gv_stashsv(classname, 0);
-
- SP -= items;
-
- mXPUSHi(class_stash ? HvMROMETA(class_stash)->pkg_gen : 0);
-
- PUTBACK;
- return;
-}
-
/*
* Local variables:
* c-indentation-style: bsd
projects / p5sagit/p5-mst-13.2.git / blobdiff