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.149 by root, Mon Jan 22 03:44:41 2007 UTC vs.
Revision 1.153 by root, Fri Jan 26 20:59:57 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_unmagic ((SV *)self, PERL_MAGIC_ext);
123 SvREFCNT_dec ((SV *)self); 124 assert (!self);
124 } 125 }
125} 126}
126 127
127// check wether the object really is dead 128// check wether the object really is dead
128void 129void
129attachable::do_check () 130attachable::do_check ()
130{ 131{
131 if (refcnt > 0 || refcnt_cnt () > 0) 132 if (refcnt_cnt () > 0)
132 return; 133 return;
133 134
134 destroy (); 135 destroy ();
136}
137
138void
139attachable::do_destroy ()
140{
141 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
142
143 if (cb)
144 {
145 SvREFCNT_dec (cb);
146 cb = 0;
147 }
135 148
136 if (self) 149 if (self)
137 { 150 {
138 hv_clear (self); 151 hv_clear (self);
139 sv_unmagic ((SV *)self, PERL_MAGIC_ext); 152 sv_unmagic ((SV *)self, PERL_MAGIC_ext);
140 SvREFCNT_dec (self); 153 // self is now 0
141 self = 0; 154 assert (!self);//D//TODO remove soon
142 } 155 }
143}
144
145void
146attachable::do_destroy ()
147{
148 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
149
150 if (self)
151 hv_clear (self);
152 156
153 mortals.push_back (this); 157 mortals.push_back (this);
154} 158}
155 159
156void 160void
… …
164} 168}
165 169
166void 170void
167attachable::check_mortals () 171attachable::check_mortals ()
168{ 172{
169 for (int i = 0; i < mortals.size (); ) 173 static int i = 0;
174
175 for (;;)
170 { 176 {
177 if (i >= mortals.size ())
178 {
179 i = 0;
180
181 if (mortals.size () > 1000)
182 fprintf (stderr, "mortal queue size (%d) exceeds 1000.\n", (int)mortals.size ());
183
184 break;
185 }
186
171 attachable *obj = mortals [i]; 187 attachable *obj = mortals [i];
172 188
173 obj->refcnt_chk (); // unborrow from perl, if necessary 189 obj->refcnt_chk (); // unborrow from perl, if necessary
174 190
191 //if (obj->refcnt > 0 || obj->self)
175 if (obj->refcnt || obj->self) 192 if (obj->refcnt || obj->self)
176 { 193 {
177#if 0 194//printf ("%p rc %d\n", obj, obj->refcnt_cnt ());//D
178 if (mortals.size() > 5)fprintf (stderr, "%d delaying %d:%p:%s %d (self %p:%d)\n", time(0),i, obj, typeid (*obj).name (),
179 obj->refcnt, obj->self, obj->self ? SvREFCNT(obj->self): - 1);//D
180#endif
181
182 ++i; // further delay freeing 195 ++i; // further delay freeing
196
197 if (!(i & 0x3ff))
198 break;
183 }//D 199 }
184 else 200 else
185 { 201 {
186 //Dfprintf (stderr, "deleteing %d:%p:%s\n", i, obj,typeid (*obj).name ());//D
187 mortals.erase (i); 202 mortals.erase (i);
188 delete obj; 203 delete obj;
189 } 204 }
190 } 205 }
191} 206}
… …
216 231
217static int 232static int
218attachable_free (pTHX_ SV *sv, MAGIC *mg) 233attachable_free (pTHX_ SV *sv, MAGIC *mg)
219{ 234{
220 attachable *at = (attachable *)mg->mg_ptr; 235 attachable *at = (attachable *)mg->mg_ptr;
236
237 //TODO: check if transaction behaviour is really required here
238 if (SV *self = (SV *)at->self)
239 {
221 at->self = 0; 240 at->self = 0;
241 SvREFCNT_dec (self);
242 }
243
222 // next line makes sense, but most objects still have refcnt 0 by default 244 // next line makes sense, but most objects still have refcnt 0 by default
223 //at->refcnt_chk (); 245 //at->refcnt_chk ();
224 return 0; 246 return 0;
225} 247}
226 248
… …
234 256
235 if (!obj->self) 257 if (!obj->self)
236 { 258 {
237 obj->self = newHV (); 259 obj->self = newHV ();
238 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0); 260 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0);
239
240 // borrow the refcnt from the object
241 // it is important thta no refcnt_chk is being executed here
242 obj->refcnt_dec ();
243 261
244 // now bless the object _once_ 262 // now bless the object _once_
245 return sv_bless (newRV_inc ((SV *)obj->self), stash); 263 return sv_bless (newRV_inc ((SV *)obj->self), stash);
246 } 264 }
247 else 265 else
… …
895void 913void
896iw::alloc () 914iw::alloc ()
897{ 915{
898 pe = GEventAPI->new_idle (0, 0); 916 pe = GEventAPI->new_idle (0, 0);
899 917
918 WaREENTRANT_off (pe);
900 pe->base.callback = (void *)iw_dispatch; 919 pe->base.callback = (void *)iw_dispatch;
901 pe->base.ext_data = (void *)this; 920 pe->base.ext_data = (void *)this;
902} 921}
903 922
904static void iow_dispatch (pe_event *ev) 923static void iow_dispatch (pe_event *ev)
… …
910void 929void
911iow::alloc () 930iow::alloc ()
912{ 931{
913 pe = GEventAPI->new_io (0, 0); 932 pe = GEventAPI->new_io (0, 0);
914 933
934 WaREENTRANT_off (pe);
915 pe->base.callback = (void *)iow_dispatch; 935 pe->base.callback = (void *)iow_dispatch;
916 pe->base.ext_data = (void *)this; 936 pe->base.ext_data = (void *)this;
917 937
918 pe->fd = -1; 938 pe->fd = -1;
919 pe->poll = 0; 939 pe->poll = 0;
… …
1690 CODE: 1710 CODE:
1691 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext); 1711 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1692 OUTPUT: 1712 OUTPUT:
1693 RETVAL 1713 RETVAL
1694 1714
1715int mortals_size ()
1716 CODE:
1717 RETVAL = attachable::mortals.size ();
1718 OUTPUT: RETVAL
1719
1720#object *mortals (U32 index)
1721# CODE:
1722# RETVAL = index < attachable::mortals.size () ? attachable::mortals [index] : 0;
1723# OUTPUT: RETVAL
1724
1695INCLUDE: $PERL genacc attachable ../include/cfperl.h | 1725INCLUDE: $PERL genacc attachable ../include/cfperl.h |
1696 1726
1697MODULE = cf PACKAGE = cf::global 1727MODULE = cf PACKAGE = cf::global
1698 1728
1699int invoke (SV *klass, int event, ...) 1729int invoke (SV *klass, int event, ...)
… …
1715 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 1745 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1716 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END); 1746 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
1717 OUTPUT: RETVAL 1747 OUTPUT: RETVAL
1718 1748
1719SV *registry (object *op) 1749SV *registry (object *op)
1720
1721void mortals ()
1722 PPCODE:
1723 EXTEND (SP, object::mortals.size ());
1724 for (AUTODECL (i, object::mortals.begin ()); i != object::mortals.end (); ++i)
1725 PUSHs (to_sv (*i));
1726 1750
1727int objects_size () 1751int objects_size ()
1728 CODE: 1752 CODE:
1729 RETVAL = objects.size (); 1753 RETVAL = objects.size ();
1730 OUTPUT: RETVAL 1754 OUTPUT: RETVAL

Diff Legend

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