view release on metacpan or  search on metacpan

api/api.c  view on Meta::CPAN

void
prima_refcnt_dec( Handle obj)
{
	if ( obj )
		--SvREFCNT( SvRV((( PAnyObject) obj)-> mate));
}

void
protect_object( Handle obj)
{
	PObject o = (PObject)obj;
	if ( o-> protectCount >= 0) o-> protectCount++;
}

void
unprotect_object( Handle obj)
{
	PObject o = (PObject)obj;
	if (!o || o-> protectCount<=0)
		return;
	o-> protectCount--;
	if (o-> protectCount>0) return;
	if (o-> stage == csDead || o-> mate == NULL || o-> mate == NULL_SV)
	{
		PAnyObject ghost, lg;

		lg = NULL;
		ghost = prima_guts.ghost_chain;
		while ( ghost != NULL && ghost != (PAnyObject) o)
		{
			lg    = ghost;
			ghost = (PAnyObject)(ghost-> killPtr);
		}
		if ( ghost == (PAnyObject) o)
		{
			if ( lg == NULL)
				prima_guts.ghost_chain = (PAnyObject)(o-> killPtr);
			else
				lg-> killPtr = o-> killPtr;
			o-> killPtr = prima_guts.kill_chain;
			prima_guts.kill_chain = (PAnyObject)o;
		}
	}
}

Bool
kind_of( Handle object, void *cls)
{
	PVMT vmt = object ? (( PAnyObject) object)-> self : NULL;
	while (( vmt != NULL) && ( vmt != cls))
		vmt = vmt-> base;
	return vmt != NULL;
}

XS( Prima_message_FROMPERL)
{
	dXSARGS;
	(void)items;
	if ( items != 1)
		croak("Invalid usage of Prima::%s", "message");
	apc_show_message((char*) SvPV_nolen( ST(0)), prima_is_utf8_sv(ST(0)));
	XSRETURN_EMPTY;
}

XS( Prima_dl_export)
{
	dXSARGS;
	(void)items;
	if ( items != 1)
		croak("Invalid usage of Prima::%s", "dl_export");
	apc_dl_export((char*) SvPV_nolen( ST(0)));
	XSRETURN_EMPTY;
}

Bool
build_dynamic_vmt( void *vvmmtt, const char *ancestorName, int ancestorVmtSize)
{
	PVMT vmt = ( PVMT) vvmmtt;
	PVMT ancestorVmt = gimme_the_vmt( ancestorName);
	int i, n;
	void **to, **from;

	if ( ancestorVmt == NULL)
	{
		warn( "GUTS001: Cannot locate base class \"%s\" of class \"%s\"\n", ancestorName, vmt-> className);
		return false;
	}
	if ( ancestorVmt-> base != ancestorVmt-> super)
	{
		warn( "GUTS002: Cannot inherit C-class \"%s\" from Perl-class \"%s\"\n", vmt-> className, ancestorName);
		return false;
	}

	vmt-> base = vmt-> super = ancestorVmt;
	n = (ancestorVmtSize - sizeof(VMT)) / sizeof( void *);
	from = (void **)((char *)ancestorVmt + sizeof(VMT));
	to = (void **)((char *)vmt + sizeof(VMT));
	for ( i = 0; i < n; i++) if ( to[i] == NULL) to[i] = from[i];
	build_static_vmt( vmt);
	prima_register_notifications( vmt);
	return true;
}

void
build_static_vmt( void *vvmmtt)
{
	PVMT vmt = ( PVMT) vvmmtt;
	hash_store( prima_guts.vmt_hash, vmt-> className, strlen( vmt-> className), vmt);
}

PVMT
gimme_the_vmt( const char *className)
{
	PVMT vmt;
	PVMT originalVmt = NULL;
	int vmtSize;
	HV *stash;
	SV **proc;
	char *newClassName;
	int i;
	void **addr;