The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#define PERL_NO_GET_CONTEXT
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>

#include "ppport.h"

#include "mro_compat.h"

#if MRO_COMPAT

#define ISA_CACHE "::XS::MRO::Compat::"

/* call &mro::get_linear_isa */
AV*
mro_compat_mro_get_linear_isa(pTHX_ HV* const stash){
	dVAR;
	GV* cachegv;
	AV* isa;  /* linearized ISA cache */
	SV* gen;  /* package generation */

	assert(stash != NULL);
	assert(SvTYPE(stash) == SVt_PVHV);

	cachegv = *(GV**)hv_fetchs(stash, ISA_CACHE, TRUE);
	if(!isGV(cachegv))
		gv_init(cachegv, stash, ISA_CACHE, sizeof(ISA_CACHE)-1, GV_ADD);

	isa = GvAVn(cachegv);
	gen = GvSVn(cachegv);

	if(SvIOK(gen) && SvIVX(gen) == (IV)mro_get_pkg_gen(stash)){
		return isa; /* returns the cache if available */
	}

	SvREADONLY_off(isa); /* unlock */
	av_clear(isa);


	{
		SV* avref;
		dSP;

		ENTER;
		SAVETMPS;

		PUSHMARK(SP);
		mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
		PUTBACK;

		call_pv("mro::get_linear_isa", G_SCALAR);

		SPAGAIN;
		avref = POPs;
		PUTBACK;

		if(SvROK(avref) && SvTYPE(SvRV(avref)) == SVt_PVAV){
			AV* const av   = (AV*)SvRV(avref);
			SV** svp       = AvARRAY(av);
			SV** const end = svp + AvFILLp(av) + 1;

			while(svp != end){
				HV* const st = gv_stashsv(*svp, FALSE);
				if(st)
					av_push(isa, newSVpv(HvNAME_get(st), 0));

				svp++;
			}
		}
		else{
			Perl_croak(aTHX_ "panic: mro::get_linear_isa() didn't return an ARRAY reference");
		}

		FREETMPS;
		LEAVE;
	}

	SvREADONLY_on(isa); /* lock */

	sv_setuv(gen, (UV)mro_get_pkg_gen(stash));
	return isa;
}

/* call &mro::method_changed_in */
void
mro_compat_mro_method_changed_in(pTHX_ HV* const stash){
	dVAR;
	dSP;

	assert(stash != NULL);
	assert(SvTYPE(stash) == SVt_PVHV);

	ENTER;
	SAVETMPS;

	PUSHMARK(SP);
	mXPUSHp(HvNAME_get(stash), HvNAMELEN_get(stash));
	PUTBACK;

	call_pv("mro::method_changed_in", G_VOID | G_DISCARD);

	FREETMPS;
	LEAVE;
}

#endif /* !MRO_COMPAT */

MODULE = XS::MRO::Compat	PACKAGE = XS::MRO::Compat

PROTOTYPES: DISABLE