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.194 by root, Mon Apr 23 18:09:57 2007 UTC vs.
Revision 1.198 by root, Fri Apr 27 19:53:05 2007 UTC

21 * You should have received a copy of the GNU General Public License 21 * You should have received a copy of the GNU General Public License
22 * along with this program; if not, write to the Free Software 22 * along with this program; if not, write to the Free Software
23 * Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 23 * Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
24 */ 24 */
25 25
26#include "autoconf.h"
27
26#define PLUGIN_NAME "perl" 28#define PLUGIN_NAME "perl"
27#define PLUGIN_VERSION "cfperl 0.5" 29#define PLUGIN_VERSION "cfperl 0.5"
28 30
29#define CEDES_PER_TICK 5 31#define CEDES_PER_TICK 5
32
33#if HAVE_EXECINFO_H
34# include <execinfo.h>
35#endif
30 36
31#include <plugin_common.h> 37#include <plugin_common.h>
32#include <sounds.h> 38#include <sounds.h>
33#include <cstdarg> 39#include <cstdarg>
34#include <sproto.h> 40#include <sproto.h>
111 117
112unordered_vector<attachable *> attachable::mortals; 118unordered_vector<attachable *> attachable::mortals;
113 119
114attachable::~attachable () 120attachable::~attachable ()
115{ 121{
116 flags |=0x3300;//D
117 assert (!self); 122 assert (!self);
118 assert (!cb); 123 assert (!cb);
119} 124}
120 125
121int 126int
137 sv_unmagic ((SV *)self, PERL_MAGIC_ext); 142 sv_unmagic ((SV *)self, PERL_MAGIC_ext);
138 SvREFCNT_dec (self); 143 SvREFCNT_dec (self);
139 144
140 // self *must* be null now because thats sv_unmagic's job. 145 // self *must* be null now because thats sv_unmagic's job.
141 assert (!this->self); 146 assert (!this->self);
142 flags |= 0x80; // severed //D
143 } 147 }
144} 148}
145 149
146void 150void
147attachable::optimise () 151attachable::optimise ()
148{ 152{
149 if (self 153 if (self
150 && SvREFCNT (self) == 1 154 && SvREFCNT (self) == 1
151 && !HvTOTALKEYS (self)) 155 && !HvTOTALKEYS (self))
152 flags |= 0x40,//D
153 sever_self (); 156 sever_self ();
154} 157}
155 158
156// check wether the object really is dead 159// check wether the object really is dead
157void 160void
172 { 175 {
173 SvREFCNT_dec (cb); 176 SvREFCNT_dec (cb);
174 cb = 0; 177 cb = 0;
175 } 178 }
176 179
177 if (self)
178 sever_self ();
179
180 flags |= 0x20; //D
181 mortals.push_back (this); 180 mortals.push_back (this);
182} 181}
183 182
184void 183void
185attachable::destroy () 184attachable::destroy ()
187 if (destroyed ()) 186 if (destroyed ())
188 return; 187 return;
189 188
190 flags |= F_DESTROYED; 189 flags |= F_DESTROYED;
191 do_destroy (); 190 do_destroy ();
191 sever_self ();
192} 192}
193 193
194void 194void
195attachable::check_mortals () 195attachable::check_mortals ()
196{ 196{
201 if (i >= mortals.size ()) 201 if (i >= mortals.size ())
202 { 202 {
203 i = 0; 203 i = 0;
204 204
205 if (mortals.size () > 1000) 205 if (mortals.size () > 1000)
206 fprintf (stderr, "mortal queue size (%d) exceeds 1000.\n", (int)mortals.size ()); 206 LOG (llevInfo, "mortal queue size (%d) exceeds 1000.\n", (int)mortals.size ());
207 207
208 break; 208 break;
209 } 209 }
210 210
211 attachable *obj = mortals [i]; 211 attachable *obj = mortals [i];
212 212
213 obj->refcnt_chk (); // unborrow from perl, if necessary 213#if 0
214 214 if (obj->self)//D make this an assert later
215 //if (obj->refcnt > 0 || obj->self)
216 if (obj->refcnt || obj->self)
217 { 215 {
218//printf ("%p rc %d\n", obj, obj->refcnt_cnt ());//D 216 LOG (llevError, "check_mortals: object '%s' still has self\n", typeid (obj).name ());
217 obj->sever_self ();
218 }
219#endif
220
221 if (obj->refcnt)
222 {
219 ++i; // further delay freeing 223 ++i; // further delay freeing
220 224
221 if (!(i & 0x3ff)) 225 if (!(i & 0x3ff))
222 break; 226 break;
223 } 227 }
224 else 228 else
225 { 229 {
226 mortals.erase (i); 230 mortals.erase (i);
231 obj->sever_self ();
227 delete obj; 232 delete obj;
228 } 233 }
229 } 234 }
230} 235}
231 236
280 285
281 if (!obj->self) 286 if (!obj->self)
282 { 287 {
283 obj->self = newHV (); 288 obj->self = newHV ();
284 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0); 289 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0);
285 obj->flags |= (obj->flags & 0xc0) << 8;
286 obj->flags &= ~0xc0;//D
287 obj->flags |= 0x10;//D
288 290
289 // now bless the object _once_ 291 // now bless the object _once_
290 return sv_bless (newRV_inc ((SV *)obj->self), stash); 292 return sv_bless (newRV_inc ((SV *)obj->self), stash);
291 } 293 }
292 else 294 else
615 perl_construct (perl); 617 perl_construct (perl);
616 618
617 PL_exit_flags |= PERL_EXIT_DESTRUCT_END; 619 PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
618 620
619 const char *argv[] = { 621 const char *argv[] = {
620 "", 622 settings.argv [0],
621 "-e" 623 "-e"
622 "use Event; use Coro;" // required for bootstrap 624 "use Event; use Coro;" // required for bootstrap
623 "cf->bootstrap;" // required for datadir :*> 625 "cf->bootstrap;" // required for datadir :*>
624 "unshift @INC, cf::datadir ();" 626 "unshift @INC, cf::datadir ();"
625 "require cf;" 627 "require cf;"
947 CALL_ARG (exit); 949 CALL_ARG (exit);
948 CALL_CALL ("cf::object::player::enter_exit", G_VOID); 950 CALL_CALL ("cf::object::player::enter_exit", G_VOID);
949 CALL_END; 951 CALL_END;
950} 952}
951 953
954void
955log_backtrace (const char *msg)
956{
957#if HAVE_BACKTRACE
958 void *addr [20];
959 int size = backtrace (addr, 20);
960
961 CALL_BEGIN (size);
962 CALL_ARG (msg);
963 for (int i = 0; i < size; ++i)
964 CALL_ARG ((IV)addr [i]);
965 CALL_CALL ("cf::_log_backtrace", G_VOID);
966 CALL_END;
967#endif
968}
969
952///////////////////////////////////////////////////////////////////////////// 970/////////////////////////////////////////////////////////////////////////////
953 971
954struct EventAPI *watcher_base::GEventAPI; 972struct EventAPI *watcher_base::GEventAPI;
955struct CoroAPI *coroapi::GCoroAPI; 973struct CoroAPI *coroapi::GCoroAPI;
956 974
1110 const char *name; 1128 const char *name;
1111 IV iv; 1129 IV iv;
1112 } *civ, const_iv[] = { 1130 } *civ, const_iv[] = {
1113# define const_iv(name) { # name, (IV)name }, 1131# define const_iv(name) { # name, (IV)name },
1114 const_iv (llevError) const_iv (llevInfo) const_iv (llevDebug) const_iv (llevMonster) 1132 const_iv (llevError) const_iv (llevInfo) const_iv (llevDebug) const_iv (llevMonster)
1133 const_iv (logBacktrace)
1115 1134
1116 const_iv (Map0Cmd) const_iv (Map1Cmd) const_iv (Map1aCmd) 1135 const_iv (Map0Cmd) const_iv (Map1Cmd) const_iv (Map1aCmd)
1117 1136
1118 const_iv (MAP_CLIENT_X) const_iv (MAP_CLIENT_Y) 1137 const_iv (MAP_CLIENT_X) const_iv (MAP_CLIENT_Y)
1119 1138
1266 1285
1267 const_iv (CS_QUERY_YESNO) const_iv (CS_QUERY_SINGLECHAR) const_iv (CS_QUERY_HIDEINPUT) 1286 const_iv (CS_QUERY_YESNO) const_iv (CS_QUERY_SINGLECHAR) const_iv (CS_QUERY_HIDEINPUT)
1268 1287
1269 const_iv (ST_DEAD) const_iv (ST_SETUP) const_iv (ST_PLAYING) const_iv (ST_CUSTOM) 1288 const_iv (ST_DEAD) const_iv (ST_SETUP) const_iv (ST_PLAYING) const_iv (ST_CUSTOM)
1270 1289
1271 const_iv (ST_CHANGE_CLASS)
1272
1273 const_iv (IO_HEADER) const_iv (IO_OBJECTS) const_iv (IO_UNIQUES) 1290 const_iv (IO_HEADER) const_iv (IO_OBJECTS) const_iv (IO_UNIQUES)
1274 1291
1275 // random map generator 1292 // random map generator
1276 const_iv (LAYOUT_NONE) const_iv (LAYOUT_ONION) const_iv (LAYOUT_MAZE) const_iv (LAYOUT_SPIRAL) 1293 const_iv (LAYOUT_NONE) const_iv (LAYOUT_ONION) const_iv (LAYOUT_MAZE) const_iv (LAYOUT_SPIRAL)
1277 const_iv (LAYOUT_ROGUELIKE) const_iv (LAYOUT_SNAKE) const_iv (LAYOUT_SQUARE_SPIRAL) 1294 const_iv (LAYOUT_ROGUELIKE) const_iv (LAYOUT_SNAKE) const_iv (LAYOUT_SQUARE_SPIRAL)
1280 const_iv (RMOPT_BOTTOM_C) const_iv (RMOPT_BOTTOM_R) const_iv (RMOPT_IRR_SPACE) 1297 const_iv (RMOPT_BOTTOM_C) const_iv (RMOPT_BOTTOM_R) const_iv (RMOPT_IRR_SPACE)
1281 const_iv (RMOPT_WALL_OFF) const_iv (RMOPT_WALLS_ONLY) const_iv (RMOPT_NO_DOORS) 1298 const_iv (RMOPT_WALL_OFF) const_iv (RMOPT_WALLS_ONLY) const_iv (RMOPT_NO_DOORS)
1282 1299
1283 const_iv (SYMMETRY_RANDOM) const_iv (SYMMETRY_NONE) const_iv (SYMMETRY_X) 1300 const_iv (SYMMETRY_RANDOM) const_iv (SYMMETRY_NONE) const_iv (SYMMETRY_X)
1284 const_iv (SYMMETRY_Y) const_iv (SYMMETRY_XY) 1301 const_iv (SYMMETRY_Y) const_iv (SYMMETRY_XY)
1302
1303 const_iv (GT_ENVIRONMENT) const_iv (GT_INVISIBLE) const_iv (GT_STARTEQUIP)
1304 const_iv (GT_APPLY) const_iv (GT_ONLY_GOOD) const_iv (GT_UPDATE_INV)
1305 const_iv (GT_MINIMAL)
1285 }; 1306 };
1286 1307
1287 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; ) 1308 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; )
1288 newCONSTSUB (stash_cf, (char *)civ->name, newSViv (civ->iv)); 1309 newCONSTSUB (stash_cf, (char *)civ->name, newSViv (civ->iv));
1289 1310
1389 CODE: 1410 CODE:
1390 runtime = SvNVx (sv_runtime); 1411 runtime = SvNVx (sv_runtime);
1391 server_tick (); 1412 server_tick ();
1392 1413
1393void 1414void
1415log_backtrace (utf8_string msg)
1416
1417void
1394LOG (int level, utf8_string msg) 1418LOG (int flags, utf8_string msg)
1395 PROTOTYPE: $$ 1419 PROTOTYPE: $$
1396 C_ARGS: (LogLevel)level, "%s", msg 1420 C_ARGS: flags, "%s", msg
1397 1421
1398octet_string path_combine (octet_string base, octet_string path) 1422octet_string path_combine (octet_string base, octet_string path)
1399 PROTOTYPE: $$ 1423 PROTOTYPE: $$
1400 1424
1401octet_string path_combine_and_normalize (octet_string base, octet_string path) 1425octet_string path_combine_and_normalize (octet_string base, octet_string path)

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines