1 #include "apricot.h"
2 #include "Object.h"
3 #include <Object.inc>
4
5 #ifdef __cplusplus
6 extern "C" {
7 #endif
8
9
10 #undef my
11 #define my ((( PObject) self)-> self)
12 #define var (( PObject) self)
13
14 Handle
Object_create(char * className,HV * profile)15 Object_create( char *className, HV * profile)
16 {
17 dSP;
18 Handle self = 0;
19
20 SV *xmate;
21 SV *profRef;
22
23 if ( primaObjects == NULL)
24 return NULL_HANDLE;
25
26 ENTER;
27 SAVETMPS;
28 PUSHMARK( sp);
29 XPUSHs( sv_2mortal( newSVpv( className, 0)));
30 PUTBACK;
31 PERL_CALL_METHOD( "CREATE", G_SCALAR);
32 SPAGAIN;
33 xmate = newRV_inc( SvRV( POPs));
34 self = create_mate( xmate);
35 var-> mate = xmate;
36 var-> stage = csDeadInInit;
37 PUTBACK;
38 FREETMPS;
39 LEAVE;
40
41 profRef = newRV_inc(( SV *) profile);
42 my-> profile_add( self, profRef);
43 SPAGAIN;
44 {
45 dG_EVAL_ARGS;
46 ENTER;
47 SAVETMPS;
48 PUSHMARK( sp);
49 XPUSHs( var-> mate);
50 sp = push_hv_for_REDEFINED( sp, profile);
51 PUTBACK;
52
53 OPEN_G_EVAL;
54 PERL_CALL_METHOD( "init", G_VOID|G_DISCARD|G_EVAL);
55 if ( SvTRUE( GvSV( PL_errgv))) {
56 CLOSE_G_EVAL;
57 OPEN_G_EVAL;
58 Object_destroy( self);
59 CLOSE_G_EVAL;
60 croak( "%s", SvPV_nolen( GvSV( PL_errgv)));
61 }
62 CLOSE_G_EVAL;
63 SPAGAIN;
64 FREETMPS;
65 LEAVE;
66 }
67 if ( primaObjects)
68 hash_store( primaObjects, &self, sizeof( self), (void*)1);
69 SvREFCNT_dec( profRef);
70 if ( var-> stage > csConstructing) {
71 if ( var-> mate && ( var-> mate != NULL_SV) && SvRV( var-> mate))
72 --SvREFCNT( SvRV( var-> mate));
73 return NULL_HANDLE;
74 }
75 var-> stage = csNormal;
76 my-> setup( self);
77 return self;
78 }
79
80 #define csHalfDead csFrozen
81
82 static void
protect_chain(Handle self,int direction)83 protect_chain( Handle self, int direction)
84 {
85 while ( self) {
86 var-> destroyRefCount += direction;
87 self = var-> owner;
88 }
89 }
90
91 void
Object_destroy(Handle self)92 Object_destroy( Handle self)
93 {
94 SV *mate, *object = NULL;
95 int enter_stage = var-> stage;
96
97 if ( var-> stage == csDeadInInit) {
98 /* lightweight destroy */
99 if ( is_opt( optInDestroyList)) {
100 list_delete( &postDestroys, self);
101 opt_clear( optInDestroyList);
102 }
103 if ( primaObjects)
104 hash_delete( primaObjects, &self, sizeof( self), false);
105 mate = var-> mate;
106 var-> stage = csDead;
107 var-> mate = NULL_SV;
108 if ( mate && object) sv_free( mate);
109 return;
110 }
111
112 if ( var-> stage > csNormal && var-> stage != csHalfDead)
113 return;
114
115 if ( var-> destroyRefCount > 0) {
116 if ( !is_opt( optInDestroyList)) {
117 opt_set( optInDestroyList);
118 list_add( &postDestroys, self);
119 }
120 return;
121 }
122
123 if ( var-> stage == csHalfDead) {
124 Handle owner;
125 if ( !var-> mate || ( var-> mate == NULL_SV))
126 return;
127 object = SvRV( var-> mate);
128 if ( !object)
129 return;
130 var-> stage = csFinalizing;
131 recursiveCall++;
132 protect_chain( owner = var-> owner, 1);
133 my-> done( self);
134 protect_chain( owner, -1);
135 recursiveCall--;
136 if ( is_opt( optInDestroyList)) {
137 list_delete( &postDestroys, self);
138 opt_clear( optInDestroyList);
139 }
140 if ( primaObjects)
141 hash_delete( primaObjects, &self, sizeof( self), false);
142 var-> stage = csDead;
143 return;
144 }
145 var-> stage = csDestroying;
146 mate = var-> mate;
147 if ( mate && ( mate != NULL_SV)) {
148 object = SvRV( mate);
149 if ( object) ++SvREFCNT( object);
150 }
151 if ( object) {
152 Handle owner;
153 var-> stage = csHalfDead;
154 recursiveCall++;
155 /* ENTER;
156 SAVEINT recursiveCall; */
157 protect_chain( owner = var-> owner, 1);
158 if ( enter_stage > csConstructing)
159 my-> cleanup( self);
160 else if ( enter_stage == csConstructing && var-> transient_class)
161 ((PObject_vmt)var-> transient_class)-> cleanup( self);
162 if ( var-> stage == csHalfDead) {
163 var-> stage = csFinalizing;
164 my-> done( self);
165 if ( primaObjects)
166 hash_delete( primaObjects, &self, sizeof( self), false);
167 if ( is_opt( optInDestroyList)) {
168 list_delete( &postDestroys, self);
169 opt_clear( optInDestroyList);
170 }
171 }
172 protect_chain( owner, -1);
173 /* LEAVE; */
174 recursiveCall--;
175 }
176 var-> stage = csDead;
177 var-> mate = NULL_SV;
178 if ( mate && object) sv_free( mate);
179
180 while (( recursiveCall == 0) && ( postDestroys. count > 0)) {
181 Handle last = postDestroys. items[ 0];
182 recursiveCall++;
183 Object_destroy( postDestroys. items[ 0]);
184 recursiveCall--;
185 if ( postDestroys. count == 0) break;
186 if ( postDestroys. items[ 0] != last) continue;
187 if ( postDestroys. count == 1)
188 croak("Zombie detected: %p", (void*)last);
189 else {
190 list_delete_at( &postDestroys, 0);
191 list_add( &postDestroys, last);
192 }
193 }
194 }
195
XS(Object_alive_FROMPERL)196 XS( Object_alive_FROMPERL)
197 {
198 dXSARGS;
199 Handle _c_apricot_self_;
200 int ret;
201
202 if ( items != 1)
203 croak("Invalid usage of Prima::Object::%s", "alive");
204 _c_apricot_self_ = gimme_the_real_mate( ST( 0));
205 SPAGAIN;
206 SP -= items;
207 if ( _c_apricot_self_ != NULL_HANDLE) {
208 switch ((( PObject) _c_apricot_self_)-> stage) {
209 case csDeadInInit:
210 case csConstructing:
211 ret = 2;
212 break;
213 case csNormal:
214 ret = 1;
215 break;
216 default:
217 ret = 0;
218 }
219 } else
220 ret = 0;
221 XPUSHs( sv_2mortal( newSViv( ret)));
222 PUTBACK;
223 return;
224 }
225
226
Object_done(Handle self)227 void Object_done ( Handle self) {}
228
Object_init(Handle self,HV * profile)229 void Object_init ( Handle self, HV * profile)
230 {
231 if ( var-> stage != csDeadInInit) croak( "Unexpected call of Object::init");
232 var-> stage = csConstructing;
233 CORE_INIT_TRANSIENT(Object);
234 }
235
Object_cleanup(Handle self)236 void Object_cleanup ( Handle self) {}
Object_setup(Handle self)237 void Object_setup( Handle self) {}
238
239 #ifdef __cplusplus
240 }
241 #endif
242