Prima
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
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;
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.547 second using v1.00-cache-2.02-grep-82fe00e-cpan-1925d2aa809 )