Codebase list libhash-fieldhash-perl / debian/0.12-2 compat58.h
debian/0.12-2

Tree @debian/0.12-2 (Download .tar.gz)

compat58.h @debian/0.12-2raw · history · blame

/* compat58.h */

#ifndef HV_FETCH
#define HV_FETCH          0x00
#endif

#ifndef HV_FETCH_ISSTORE
#define HV_FETCH_ISSTORE  0x04
#define HV_FETCH_ISEXISTS 0x08
#define HV_FETCH_LVALUE   0x10
#define HV_FETCH_JUST_SV  0x20
#define HV_DELETE         0x40
#endif

static MGVTBL fieldhash_vtbl;
#define fieldhash_mg(sv) mg_find_by_vtbl(sv, &fieldhash_vtbl)

static I32 fieldhash_watch(pTHX_ IV const action, SV* const fieldhash);

static SV*
hf_replace_key(pTHX_ HV* const impl, SV* key, IV const action){
	MAGIC* const mg = fieldhash_mg((SV*)impl);

	if(!mg){
		Perl_croak(aTHX_ "panic: invalid fieldhash");
	}

	mg->mg_obj = key;
	fieldhash_watch(aTHX_ action, (SV*)impl);
	key = mg->mg_obj;
	mg->mg_obj = NULL;

	return key;
}

static HV*
fieldhash_get_impl(pTHX_ HV* const fieldhash){
	MAGIC* const tied_mg  = SvTIED_mg((SV*)fieldhash, PERL_MAGIC_tied);
	SV*    const tied_obj = SvTIED_obj((SV*)fieldhash, tied_mg);

	assert(sv_derived_from(tied_obj, PACKAGE));
	assert(SvROK(tied_obj));
	assert(SvTYPE(SvRV(tied_obj)) == SVt_PVHV);

	return (HV*)SvRV(tied_obj);
}

static SV*
fieldhash_fetch(pTHX_ HV* const fieldhash, SV* const key){
	HV* const impl = fieldhash_get_impl(aTHX_ fieldhash);
	HE* he;

	he = hv_fetch_ent(impl, hf_replace_key(aTHX_ impl, key, HV_FETCH), FALSE, 0U);
	return he ? HeVAL(he) : &PL_sv_undef;
}

static void
fieldhash_store(pTHX_ HV* const fieldhash, SV* const key, SV* const val){
	HV* const impl = fieldhash_get_impl(aTHX_ fieldhash);

	(void)hv_store_ent(impl, hf_replace_key(aTHX_ impl, key, HV_FETCH_ISSTORE), val, 0U);
}