/*-
* Copyright (c) 1997-2002 The Protein Laboratory, University of Copenhagen
* All rights reserved.
*
* Redistribution and use in source and binary forms, with or without
* modification, are permitted provided that the following conditions
* are met:
* 1. Redistributions of source code must retain the above copyright
* notice, this list of conditions and the following disclaimer.
* 2. Redistributions in binary form must reproduce the above copyright
* notice, this list of conditions and the following disclaimer in the
* documentation and/or other materials provided with the distribution.
*
* THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
* ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
* IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
* ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE
* FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
* DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
* OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
* HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
* LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
* OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
* SUCH DAMAGE.
*
* $Id$
*/
#include "apricot.h"
#include "Object.h"
#include <Object.inc>
#ifdef __cplusplus
extern "C" {
#endif
#undef my
#define my ((( PObject) self)-> self)
#define var (( PObject) self)
Handle
Object_create( char *className, HV * profile)
{
dSP;
Handle self = 0;
SV *xmate;
SV *profRef;
if ( primaObjects == nil)
return nilHandle;
ENTER;
SAVETMPS;
PUSHMARK( sp);
XPUSHs( sv_2mortal( newSVpv( className, 0)));
PUTBACK;
PERL_CALL_METHOD( "CREATE", G_SCALAR);
SPAGAIN;
xmate = newRV_inc( SvRV( POPs));
self = create_mate( xmate);
var-> mate = xmate;
var-> stage = csDeadInInit;
PUTBACK;
FREETMPS;
LEAVE;
profRef = newRV_inc(( SV *) profile);
my-> profile_add( self, profRef);
SPAGAIN;
{
dG_EVAL_ARGS;
ENTER;
SAVETMPS;
PUSHMARK( sp);
XPUSHs( var-> mate);
sp = push_hv_for_REDEFINED( sp, profile);
PUTBACK;
OPEN_G_EVAL;
PERL_CALL_METHOD( "init", G_VOID|G_DISCARD|G_EVAL);
if ( SvTRUE( GvSV( PL_errgv))) {
CLOSE_G_EVAL;
OPEN_G_EVAL;
Object_destroy( self);
CLOSE_G_EVAL;
croak( "%s", SvPV_nolen( GvSV( PL_errgv)));
}
CLOSE_G_EVAL;
SPAGAIN;
FREETMPS;
LEAVE;
}
if ( primaObjects)
hash_store( primaObjects, &self, sizeof( self), (void*)1);
SvREFCNT_dec( profRef);
if ( var-> stage > csConstructing) {
if ( var-> mate && ( var-> mate != nilSV) && SvRV( var-> mate))
--SvREFCNT( SvRV( var-> mate));
return nilHandle;
}
var-> stage = csNormal;
my-> setup( self);
return self;
}
#define csHalfDead csFrozen
static void
protect_chain( Handle self, int direction)
{
while ( self) {
var-> destroyRefCount += direction;
self = var-> owner;
}
}
void
Object_destroy( Handle self)
{
SV *mate, *object = nil;
int enter_stage = var-> stage;
if ( var-> stage == csDeadInInit) {
/* lightweight destroy */
if ( is_opt( optInDestroyList)) {
list_delete( &postDestroys, self);
opt_clear( optInDestroyList);
}
if ( primaObjects)
hash_delete( primaObjects, &self, sizeof( self), false);
mate = var-> mate;
var-> stage = csDead;
var-> mate = nilSV;
if ( mate && object) sv_free( mate);
return;
}
if ( var-> stage > csNormal && var-> stage != csHalfDead)
return;
if ( var-> destroyRefCount > 0) {
if ( !is_opt( optInDestroyList)) {
opt_set( optInDestroyList);
list_add( &postDestroys, self);
}
return;
}
if ( var-> stage == csHalfDead) {
Handle owner;
if ( !var-> mate || ( var-> mate == nilSV))
return;
object = SvRV( var-> mate);
if ( !object)
return;
var-> stage = csFinalizing;
recursiveCall++;
protect_chain( owner = var-> owner, 1);
my-> done( self);
protect_chain( owner, -1);
recursiveCall--;
if ( is_opt( optInDestroyList)) {
list_delete( &postDestroys, self);
opt_clear( optInDestroyList);
}
if ( primaObjects)
hash_delete( primaObjects, &self, sizeof( self), false);
var-> stage = csDead;
return;
}
var-> stage = csDestroying;
mate = var-> mate;
if ( mate && ( mate != nilSV)) {
object = SvRV( mate);
if ( object) ++SvREFCNT( object);
}
if ( object) {
Handle owner;
var-> stage = csHalfDead;
recursiveCall++;
/* ENTER;
SAVEINT recursiveCall; */
protect_chain( owner = var-> owner, 1);
if ( enter_stage > csConstructing)
my-> cleanup( self);
else if ( enter_stage == csConstructing && var-> transient_class)
((PObject_vmt)var-> transient_class)-> cleanup( self);
if ( var-> stage == csHalfDead) {
var-> stage = csFinalizing;
my-> done( self);
if ( primaObjects)
hash_delete( primaObjects, &self, sizeof( self), false);
if ( is_opt( optInDestroyList)) {
list_delete( &postDestroys, self);
opt_clear( optInDestroyList);
}
}
protect_chain( owner, -1);
/* LEAVE; */
recursiveCall--;
}
var-> stage = csDead;
var-> mate = nilSV;
if ( mate && object) sv_free( mate);
while (( recursiveCall == 0) && ( postDestroys. count > 0)) {
Handle last = postDestroys. items[ 0];
recursiveCall++;
Object_destroy( postDestroys. items[ 0]);
recursiveCall--;
if ( postDestroys. count == 0) break;
if ( postDestroys. items[ 0] != last) continue;
if ( postDestroys. count == 1)
croak("Zombie detected: %p", (void*)last);
else {
list_delete_at( &postDestroys, 0);
list_add( &postDestroys, last);
}
}
}
XS( Object_alive_FROMPERL)
{
dXSARGS;
Handle _c_apricot_self_;
int ret;
if ( items != 1)
croak("Invalid usage of Prima::Object::%s", "alive");
_c_apricot_self_ = gimme_the_real_mate( ST( 0));
SPAGAIN;
SP -= items;
if ( _c_apricot_self_ != nilHandle) {
switch ((( PObject) _c_apricot_self_)-> stage) {
case csDeadInInit:
case csConstructing:
ret = 2;
break;
case csNormal:
ret = 1;
break;
default:
ret = 0;
}
} else
ret = 0;
XPUSHs( sv_2mortal( newSViv( ret)));
PUTBACK;
return;
}
void Object_done ( Handle self) {}
void Object_init ( Handle self, HV * profile)
{
if ( var-> stage != csDeadInInit) croak( "Unexpected call of Object::init");
var-> stage = csConstructing;
CORE_INIT_TRANSIENT(Object);
}
void Object_cleanup ( Handle self) {}
void Object_setup( Handle self) {}
#ifdef __cplusplus
}
#endif