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.12 by root, Sat Aug 26 23:36:33 2006 UTC vs.
Revision 1.13 by root, Sun Aug 27 16:15:13 2006 UTC

… …
28#include <XSUB.h> 28#include <XSUB.h>
29 29
30#undef save_long // clashes with libproto.h 30#undef save_long // clashes with libproto.h
31 31
32#define PLUGIN_NAME "perl" 32#define PLUGIN_NAME "perl"
33#define PLUGIN_VERSION "cfperl 0.3" 33#define PLUGIN_VERSION "cfperl 0.5"
34 34
35#ifndef __CEXTRACT__ 35#ifndef __CEXTRACT__
36#include <plugin.h> 36#include <plugin.h>
37#endif 37#endif
38 38
… …
97#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int)))) 97#define PUSH_IV PUSHs (sv_2mortal (newSViv (va_arg (args, int))))
98 98
99////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 99//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
100 100
101static SV * 101static SV *
102newSVptr (void *ptr, const char *klass) 102newSVptr (void *ptr, const char *klass, HV *hv = newHV ())
103{ 103{
104 SV *sv; 104 SV *sv;
105 105
106 if (!ptr) 106 if (!ptr)
107 return &PL_sv_undef; 107 return &PL_sv_undef;
108 108
109 sv = (SV *)newHV ();
110 sv_magic (sv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 109 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
111 return sv_bless (newRV_noinc (sv), gv_stashpv (klass, 1)); 110 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
112} 111}
113 112
114template<class extendable> 113template<class extendable>
115SV * 114SV *
116newSVextendable (extendable *obj, const char *klass) 115newSVextendable (extendable *obj, const char *klass)
… …
305} 304}
306 305
307////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 306//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
308 307
309SV * 308SV *
310registry_of (extendable_base *obj) 309registry_of (extendable_base *ext)
311{ 310{
312 if (!obj->cb) 311 if (!ext->cb)
313 obj->cb = newAV (); 312 ext->cb = newAV ();
314 313
315 return newRV_inc ((SV *)obj->cb); 314 return newRV_inc ((SV *)ext->cb);
316} 315}
317 316
318void extendable_base::clear () 317void extendable_base::clear ()
319{ 318{
320 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D 319 //if (self) fprintf (stderr, "free_ob_self %p %s (%p,%p)\n", this, ((object *)this)->name, self, cb);//D
… …
329 attach = 0; 328 attach = 0;
330} 329}
331 330
332void extendable_base::optimise () 331void extendable_base::optimise ()
333{ 332{
334 // optional, and not used yet anyways 333 if (!self)
335// // empty and unreferenced? nuke it 334 return;
336// if (SvREFCNT (sv) == 1 && SvREFCNT (SvRV (sv)) == 1 && !HvFILL ((HV *)(SvRV (sv))))
337// {
338// hv_delete (obj_cache, HeKEY (he), HeKLEN (he), G_DISCARD);
339// todo++;
340// }
341 335
342} 336 HV *hv = (HV *)SvRV ((SV *)self);
343 337
344void extendable_base::reattach (data_type type, void *self) 338 if (SvREFCNT ((SV *)self) == 1
345{ 339 && SvREFCNT ((SV *)hv) == 1
346 dSP; 340 && !HvKEYS (hv))
347 ENTER; 341 {
348 SAVETMPS; 342 SvREFCNT_dec ((SV *)self);
349 PUSHMARK (SP); 343 self = 0;
350 EXTEND (SP, 1); 344 }
351 PUSHs (sv_2mortal (newSVdt (type, self)));
352 PUTBACK;
353 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
354 FREETMPS;
355 LEAVE;
356
357 if (cb && type == DT_OBJECT)
358 INVOKE_OBJECT (LOAD, (object *)self);
359} 345}
360 346
361void 347void
362object::instantiate_ () 348object::instantiate_ ()
363{ 349{
… …
370 PUSHs (sv_2mortal (newSVpv (attach, 0))); 356 PUSHs (sv_2mortal (newSVpv (attach, 0)));
371 PUTBACK; 357 PUTBACK;
372 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL); 358 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
373 FREETMPS; 359 FREETMPS;
374 LEAVE; 360 LEAVE;
361}
362
363/////////////////////////////////////////////////////////////////////////////
364
365object_freezer::object_freezer (const char *filename)
366: filename (filename)
367{
368 av = (AV *)newAV ();
369 idx = 0;
370 av_extend ((AV *)av, 1024);
371}
372
373object_freezer::~object_freezer ()
374{
375 dSP;
376 ENTER;
377 SAVETMPS;
378 PUSHMARK (SP);
379 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
380 XPUSHs (sv_2mortal (newRV_noinc ((SV *)av)));
381 PUTBACK;
382 call_pv ("cf::object_freezer_save", G_VOID | G_DISCARD | G_EVAL);
383 FREETMPS;
384 LEAVE;
385}
386
387void object_freezer::put (extendable_base *ext)
388{
389 ext->optimise ();
390
391 if (ext->self)
392 av_store ((AV *)av, idx, SvREFCNT_inc ((SV *)ext->self));
393
394 ++idx;
395}
396
397object_thawer::object_thawer (const char *filename)
398{
399 av = 0;
400 idx = 0;
401
402 if (!filename)
403 return;
404
405 dSP;
406 ENTER;
407 SAVETMPS;
408 PUSHMARK (SP);
409 XPUSHs (sv_2mortal (newSVpv (filename, 0)));
410 PUTBACK;
411
412 if (0 < call_pv ("cf::object_thawer_load", G_SCALAR | G_EVAL))
413 {
414 SPAGAIN;
415 SV *sv = POPs;
416 if (SvROK (sv))
417 av = SvREFCNT_inc (SvRV (sv));
418 }
419
420 FREETMPS;
421 LEAVE;
422}
423
424void object_thawer::get (data_type type, void *obj, extendable_base *ext)
425{
426 if (!av)
427 return;
428
429 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach
430 ext->clear ();
431
432 SV **svp = av_fetch ((AV *)av, idx, 0);
433
434 ++idx;
435
436 if (!svp)
437 return;
438
439 if (SvROK (*svp))
440 {
441 ext->self = SvREFCNT_inc (*svp);
442 sv_magic (SvRV ((SV *)ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0);
443
444 dSP;
445 ENTER;
446 SAVETMPS;
447 PUSHMARK (SP);
448 EXTEND (SP, 1);
449 PUSHs (sv_2mortal (newSVdt (type, obj)));
450 PUTBACK;
451 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
452 FREETMPS;
453 LEAVE;
454
455 if (ext->cb && type == DT_OBJECT)
456 INVOKE_OBJECT (REATTACH, (object *)obj);
457 }
458}
459
460object_thawer::~object_thawer ()
461{
462 if (av)
463 SvREFCNT_dec ((SV *)av);
375} 464}
376 465
377///////////////////////////////////////////////////////////////////////////// 466/////////////////////////////////////////////////////////////////////////////
378 467
379extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr) 468extern "C" int cfperl_initPlugin (const char *iversion, f_plug_api gethooksptr)
… …
614 case KLASS_PLAYER: 703 case KLASS_PLAYER:
615 dt = (data_type) va_arg (ap, int); 704 dt = (data_type) va_arg (ap, int);
616 assert (("first argument must be of type player", dt == DT_PLAYER)); 705 assert (("first argument must be of type player", dt == DT_PLAYER));
617 pl = va_arg (ap, player *); 706 pl = va_arg (ap, player *);
618 707
619 if (op->cb) 708 if (pl->cb)
620 gather_callbacks (callbacks, (AV *)op->cb, event); 709 gather_callbacks (callbacks, (AV *)pl->cb, event);
621 710
622 gather_callbacks (callbacks, cb_player, event); 711 gather_callbacks (callbacks, cb_player, event);
623 break; 712 break;
624 713
625 case KLASS_MAP: 714 case KLASS_MAP:
626 dt = (data_type) va_arg (ap, int); 715 dt = (data_type) va_arg (ap, int);
627 assert (("first argument must be of type object", dt == DT_MAP)); 716 assert (("first argument must be of type object", dt == DT_MAP));
628 map = va_arg (ap, mapstruct *); 717 map = va_arg (ap, mapstruct *);
629 718
630 if (op->cb) 719 if (map->cb)
631 gather_callbacks (callbacks, (AV *)op->cb, event); 720 gather_callbacks (callbacks, (AV *)map->cb, event);
632 721
633 gather_callbacks (callbacks, cb_map, event); 722 gather_callbacks (callbacks, cb_map, event);
634 break; 723 break;
635 724
636 default: 725 default:
… …
2057 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2146 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2058 } 2147 }
2059 OUTPUT: 2148 OUTPUT:
2060 RETVAL 2149 RETVAL
2061 2150
2062# "serialise" map perl data into a ref 2151# "deserialise" perl map data into the map # TODO# compatibility cruft, remove
2063void
2064_get_obs (mapstruct *map)
2065 PPCODE:
2066{
2067 object *o;
2068 int x, y;
2069 AV *obs = newAV ();
2070 int nonnull = 0;
2071
2072 for (y = 0; y < MAP_HEIGHT (map); y++)
2073 for (x = 0; x < MAP_WIDTH (map); x++)
2074 {
2075 AV *av = newAV ();
2076
2077 for (o = GET_MAP_OB (map, x, y); o; o = o->above)
2078 {
2079 SV *sv = SVptr_cache_get (o);
2080
2081 if (sv && HvFILL (SvRV (sv)))
2082 {
2083 nonnull = 1;
2084 sv = newSVsv (sv);
2085 }
2086 else
2087 sv = &PL_sv_undef;
2088
2089 av_push (av, sv);
2090 }
2091
2092 av_store (obs, x + y * MAP_HEIGHT (map), newRV_noinc ((SV *)av));
2093 }
2094
2095 if (nonnull)
2096 XPUSHs (sv_2mortal (newRV_noinc ((SV *)obs)));
2097 else
2098 SvREFCNT_dec (obs);
2099}
2100
2101# "deserialise" perl map data into the map
2102void 2152void
2103_set_obs (mapstruct *map, SV *sv) 2153_set_obs (mapstruct *map, SV *sv)
2104 CODE: 2154 CODE:
2105{ 2155{
2106 object *o; 2156 object *o;

Diff Legend

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