void unroll_this(pTHX_ OP* op) {
struct sljit_compiler* compiler = sljit_create_compiler();
HV* seenops = newHV();
#ifdef DEBUG
if (getenv("RUNOPS_OPTIMIZED_DEBUG")) {
CV *runcv = Perl_find_runcv(NULL);
sljit_compiler_verbose(compiler, stderr);
DEBUGf(("Unroll %s::%s cv=%p, op=%p (%s)\n", HvNAME_get(CvSTASH(runcv)),
GvENAME(CvGV(runcv)), runcv, op, sljit_get_platform_name()));
}
#endif
sljit_emit_enter(compiler, 0, 2, 1, 0);
unroll_tree(compiler, seenops, op, NULL);
fixup_jumps(compiler, needjumps, labels);
// This is needed for things that drop off the runloop without a
// return, e.g. S_sortcv. TODO: Make conditional?
sljit_emit_return(compiler, SLJIT_MEM, (sljit_w) &PL_op);
op->op_ppaddr = sljit_generate_code(compiler);
op->op_spare = 3;
DEBUGf(("Code at %p\n", op->op_ppaddr));
labels = NULL;
needjumps = NULL;
SvREFCNT_dec(seenops);
sljit_free_compiler(compiler);
}
/*
=for apidoc mro_method_changed_in
Invalidates method caching on any child classes
of the given stash, so that they might notice
the changes in this one.
Ideally, all instances of C<PL_sub_generation++> in
perl source outside of C<mro.c> should be
replaced by calls to this.
Perl automatically handles most of the common
ways a method might be redefined. However, there
are a few ways you could change a method in a stash
without the cache code noticing, in which case you
need to call this method afterwards:
1) Directly manipulating the stash HV entries from
XS code.
2) Assigning a reference to a readonly scalar
constant into a stash entry in order to create
a constant subroutine (like constant.pm
does).
This same method is available from pure perl
via, C<mro::method_changed_in(classname)>.
=cut
*/
void
Perl_mro_method_changed_in(pTHX_ HV *stash)
{
const char * const stashname = HvNAME_get(stash);
const STRLEN stashname_len = HvNAMELEN_get(stash);
SV ** const svp = hv_fetch(PL_isarev, stashname, stashname_len, 0);
HV * const isarev = svp ? MUTABLE_HV(*svp) : NULL;
PERL_ARGS_ASSERT_MRO_METHOD_CHANGED_IN;
if(!stashname)
Perl_croak(aTHX_ "Can't call mro_method_changed_in() on anonymous symbol table");
/* Inc the package generation, since a local method changed */
HvMROMETA(stash)->pkg_gen++;
/* If stash is UNIVERSAL, or one of UNIVERSAL's parents,
invalidate all method caches globally */
if((stashname_len == 9 && strEQ(stashname, "UNIVERSAL"))
|| (isarev && hv_exists(isarev, "UNIVERSAL", 9))) {
PL_sub_generation++;
return;
}
/* else, invalidate the method caches of all child classes,
but not itself */
if(isarev) {
HE* iter;
hv_iterinit(isarev);
while((iter = hv_iternext(isarev))) {
I32 len;
const char* const revkey = hv_iterkey(iter, &len);
HV* const revstash = gv_stashpvn(revkey, len, 0);
struct mro_meta* mrometa;
if(!revstash) continue;
mrometa = HvMROMETA(revstash);
mrometa->cache_gen++;
if(mrometa->mro_nextmethod)
hv_clear(mrometa->mro_nextmethod);
}
}
}
/*
=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);
}
}
}
}
