ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/deliantra/server/server/cfperl.xs
(Generate patch)

Comparing deliantra/server/server/cfperl.xs (file contents):
Revision 1.151 by root, Tue Jan 23 01:29:51 2007 UTC vs.
Revision 1.154 by root, Fri Jan 26 21:44:11 2007 UTC

… …
102unordered_vector<attachable *> attachable::mortals; 102unordered_vector<attachable *> attachable::mortals;
103 103
104attachable::~attachable () 104attachable::~attachable ()
105{ 105{
106 assert (!self); 106 assert (!self);
107 assert (!cb);
107} 108}
108 109
109int 110int
110attachable::refcnt_cnt () const 111attachable::refcnt_cnt () const
111{ 112{
112 return refcnt + (self ? SvREFCNT (self) : 0); 113 return refcnt + (self ? SvREFCNT (self) - 1 : 0);
113} 114}
114 115
115void 116void
116attachable::optimise () 117attachable::optimise ()
117{ 118{
118 if (self 119 if (self
119 && SvREFCNT (self) == 1 120 && SvREFCNT (self) == 1
120 && !HvTOTALKEYS (self)) 121 && !HvTOTALKEYS (self))
121 { 122 {
122 refcnt_inc (); 123 SV *self = (SV *)this->self;
124
125 SvREFCNT_inc (self);
126 sv_unmagic (self, PERL_MAGIC_ext);
123 SvREFCNT_dec ((SV *)self); 127 SvREFCNT_dec (self);
128 assert (!this->self);
124 } 129 }
125} 130}
126 131
127// check wether the object really is dead 132// check wether the object really is dead
128void 133void
129attachable::do_check () 134attachable::do_check ()
130{ 135{
131 if (refcnt > 0 || refcnt_cnt () > 0) 136 if (refcnt_cnt () > 0)
132 return; 137 return;
133 138
134 destroy (); 139 destroy ();
140}
141
142void
143attachable::do_destroy ()
144{
145 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
146
147 if (cb)
148 {
149 SvREFCNT_dec (cb);
150 cb = 0;
151 }
135 152
136 if (self) 153 if (self)
137 { 154 {
138 hv_clear (self); 155 hv_clear (self);
156
157 SV *self = (SV *)this->self;
158 SvREFCNT_inc (self);
139 sv_unmagic ((SV *)self, PERL_MAGIC_ext); 159 sv_unmagic (self, PERL_MAGIC_ext);
140 SvREFCNT_dec (self); 160 SvREFCNT_dec (self);
141 self = 0; 161 // self is now 0
162 assert (!this->self);//D//TODO remove soon
142 } 163 }
143}
144
145void
146attachable::do_destroy ()
147{
148 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
149
150 if (self)
151 hv_clear (self);
152 164
153 mortals.push_back (this); 165 mortals.push_back (this);
154} 166}
155 167
156void 168void
… …
173 if (i >= mortals.size ()) 185 if (i >= mortals.size ())
174 { 186 {
175 i = 0; 187 i = 0;
176 188
177 if (mortals.size () > 1000) 189 if (mortals.size () > 1000)
178 fprintf (stderr, "mortal queue size (%d) exceeds 1000.\n", mortals.size ()); 190 fprintf (stderr, "mortal queue size (%d) exceeds 1000.\n", (int)mortals.size ());
179 191
180 break; 192 break;
181 } 193 }
182 194
183 attachable *obj = mortals [i]; 195 attachable *obj = mortals [i];
… …
227 239
228static int 240static int
229attachable_free (pTHX_ SV *sv, MAGIC *mg) 241attachable_free (pTHX_ SV *sv, MAGIC *mg)
230{ 242{
231 attachable *at = (attachable *)mg->mg_ptr; 243 attachable *at = (attachable *)mg->mg_ptr;
244
245 //TODO: check if transaction behaviour is really required here
246 if (SV *self = (SV *)at->self)
247 {
232 at->self = 0; 248 at->self = 0;
249 SvREFCNT_dec (self);
250 }
251
233 // next line makes sense, but most objects still have refcnt 0 by default 252 // next line makes sense, but most objects still have refcnt 0 by default
234 //at->refcnt_chk (); 253 //at->refcnt_chk ();
235 return 0; 254 return 0;
236} 255}
237 256
… …
245 264
246 if (!obj->self) 265 if (!obj->self)
247 { 266 {
248 obj->self = newHV (); 267 obj->self = newHV ();
249 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0); 268 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0);
250
251 // borrow the refcnt from the object
252 // it is important thta no refcnt_chk is being executed here
253 obj->refcnt_dec ();
254 269
255 // now bless the object _once_ 270 // now bless the object _once_
256 return sv_bless (newRV_inc ((SV *)obj->self), stash); 271 return sv_bless (newRV_inc ((SV *)obj->self), stash);
257 } 272 }
258 else 273 else
… …
1703 CODE: 1718 CODE:
1704 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext); 1719 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1705 OUTPUT: 1720 OUTPUT:
1706 RETVAL 1721 RETVAL
1707 1722
1723int mortals_size ()
1724 CODE:
1725 RETVAL = attachable::mortals.size ();
1726 OUTPUT: RETVAL
1727
1728#object *mortals (U32 index)
1729# CODE:
1730# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
1731# OUTPUT: RETVAL
1732
1708INCLUDE: $PERL genacc attachable ../include/cfperl.h | 1733INCLUDE: $PERL genacc attachable ../include/cfperl.h |
1709 1734
1710MODULE = cf PACKAGE = cf::global 1735MODULE = cf PACKAGE = cf::global
1711 1736
1712int invoke (SV *klass, int event, ...) 1737int invoke (SV *klass, int event, ...)
… …
1728 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 1753 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1729 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END); 1754 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
1730 OUTPUT: RETVAL 1755 OUTPUT: RETVAL
1731 1756
1732SV *registry (object *op) 1757SV *registry (object *op)
1733
1734void mortals ()
1735 PPCODE:
1736 EXTEND (SP, object::mortals.size ());
1737 for (AUTODECL (i, object::mortals.begin ()); i != object::mortals.end (); ++i)
1738 PUSHs (to_sv (*i));
1739 1758
1740int objects_size () 1759int objects_size ()
1741 CODE: 1760 CODE:
1742 RETVAL = objects.size (); 1761 RETVAL = objects.size ();
1743 OUTPUT: RETVAL 1762 OUTPUT: RETVAL

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines