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.108 by elmex, Mon Dec 25 11:16:48 2006 UTC vs.
Revision 1.109 by root, Mon Dec 25 11:25:49 2006 UTC

… …
60static f_plug_api object_set_property = cfapi_object_set_property; 60static f_plug_api object_set_property = cfapi_object_set_property;
61static f_plug_api object_insert = cfapi_object_insert; 61static f_plug_api object_insert = cfapi_object_insert;
62 62
63static PerlInterpreter *perl; 63static PerlInterpreter *perl;
64 64
65global gbl_ev;
65static AV *cb_global, *cb_object, *cb_player, *cb_client, *cb_type, *cb_map; 66static AV *cb_global, *cb_attachable, *cb_object, *cb_player, *cb_client, *cb_type, *cb_map;
67
68static HV
69 *stash_cf,
70 *stash_cf_object_wrap,
71 *stash_cf_object_player_wrap,
72 *stash_cf_player_wrap,
73 *stash_cf_map_wrap,
74 *stash_cf_client_wrap,
75 *stash_cf_arch_wrap,
76 *stash_cf_party_wrap,
77 *stash_cf_region_wrap,
78 *stash_cf_living_wrap;
79
80// helper cast function, returns super class * or 0
81template<class super>
82static super *
83is_a (attachable *at)
84{
85 //return dynamic_cast<super *>(at); // slower, safer
86 if (typeid (*at) == typeid (super))
87 return static_cast<super *>(at);
88 else
89 return 0;
90}
66 91
67////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 92//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
68 93
94unordered_vector<attachable *> attachable::mortals;
95
96#if 0
97attachable *attachable::rc_first;
98
99attachable::attachable ()
100{
101 refcnt = 0;
102 rc_next = rc_first;
103 rc_first = this;
104}
105#endif
106
107attachable::~attachable ()
108{
109 assert (!(flags & F_BORROWED));//D//TODO//remove when stable
110#if 0
111 assert (!rc_next);
112 assert (!refcnt);
113#endif
114}
115
116// check wether the object really is dead
117void
118attachable::do_check ()
119{
120 if (refcnt > 0)
121 return;
122
123 // try to unborrow the refcnt from perl
124 if (flags & F_BORROWED)
125 {
126 assert (self);//D//TODO//remove when stable
127 flags &= ~F_BORROWED;
128 refcnt_inc ();
129 SvREFCNT_dec (self);
130 }
131
132 if (refcnt > 0 || self)
133 return;
134
135 destroy ();
136}
137
138void
139attachable::do_destroy ()
140{
141 invoke (EVENT_ATTACHABLE_DESTROY, DT_END);
142
143 //TODO: call generic destroy callback
144 mortals.push_back (this);
145}
146
147void
148attachable::destroy ()
149{
150 if (destroyed ())
151 return;
152
153 flags |= F_DESTROYED;
154 do_destroy ();
155}
156
157void attachable::check_mortals ()
158{
159 for (int i = 0; i < mortals.size (); )
160 {
161 attachable *obj = mortals [i];
162
163 obj->refcnt_chk (); // unborrow from perl, if necessary
164
165 if (obj->refcnt || obj->self)
166 {
167#if 0
168 if (mortals.size() > 5)fprintf (stderr, "%d delaying %d:%p:%s %d (self %p:%d)\n", time(0),i, obj, typeid (*obj).name (),
169 obj->refcnt, obj->self, obj->self ? SvREFCNT(obj->self): - 1);//D
170#endif
171
172 ++i; // further delay freeing
173 }//D
174 else
175 {
176 //Dfprintf (stderr, "deleteing %d:%p:%s\n", i, obj,typeid (*obj).name ());//D
177 delete obj;
178 mortals.erase (i);
179 }
180 }
181}
182
183attachable &
184attachable::operator =(const attachable &src)
185{
186 //if (self || cb)
187 //INVOKE_OBJECT (CLONE, this, ARG_OBJECT (dst));
188
189 attach = src.attach;
190 return *this;
191}
192
193//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
194
69static SV * 195static SV *
70newSVptr (void *ptr, const char *klass, HV *hv = newHV ()) 196newSVptr (void *ptr, HV *stash, HV *hv = newHV ())
71{ 197{
72 SV *sv; 198 SV *sv;
73 199
74 if (!ptr) 200 if (!ptr)
75 return &PL_sv_undef; 201 return &PL_sv_undef;
76 202
77 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0); 203 sv_magicext ((SV *)hv, 0, PERL_MAGIC_ext, 0, (char *)ptr, 0);
78 return sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1)); 204 return sv_bless (newRV_noinc ((SV *)hv), stash);
79} 205}
80 206
81template<class attachable> 207static int
208attachable_free (pTHX_ SV *sv, MAGIC *mg)
209{
210 attachable *at = (attachable *)mg->mg_ptr;
211 assert (!(at->flags & attachable::F_BORROWED));//D//TODO//remove when stable
212 at->self = 0;
213 at->refcnt_chk ();
214 return 0;
215}
216
217static MGVTBL vtbl_attachable = {0, 0, 0, 0, attachable_free};
218
82SV * 219SV *
83newSVattachable (attachable *obj, const char *klass) 220newSVattachable (attachable *obj, HV *stash)
84{ 221{
85 if (!obj) 222 if (!obj)
86 return &PL_sv_undef; 223 return &PL_sv_undef;
87 224
88 if (!obj->self) 225 if (!obj->self)
89 obj->self = newSVptr (obj, klass); 226 {
227 obj->self = newHV ();
228 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &vtbl_attachable, (char *)obj, 0);
90 229
91 return newSVsv (obj->self); 230 // borrow the refcnt from the object
231 obj->flags |= attachable::F_BORROWED;
232 obj->refcnt_dec ();
233 }
234
235 return sv_bless (newRV_inc ((SV *)obj->self), stash);
92} 236}
93 237
94static void 238static void
95clearSVptr (SV *sv) 239clearSVptr (SV *sv)
96{ 240{
… …
137inline SV *to_sv (unsigned long v) { return newSVuv (v); } 281inline SV *to_sv (unsigned long v) { return newSVuv (v); }
138inline SV *to_sv ( signed long long v) { return newSVval64 (v); } 282inline SV *to_sv ( signed long long v) { return newSVval64 (v); }
139inline SV *to_sv (unsigned long long v) { return newSVval64 (v); } 283inline SV *to_sv (unsigned long long v) { return newSVval64 (v); }
140inline SV *to_sv (float v) { return newSVnv (v); } 284inline SV *to_sv (float v) { return newSVnv (v); }
141inline SV *to_sv (double v) { return newSVnv (v); } 285inline SV *to_sv (double v) { return newSVnv (v); }
142inline SV *to_sv (client * v) { return newSVattachable (v, "cf::client::wrap"); } 286inline SV *to_sv (client * v) { return newSVattachable (v, stash_cf_client_wrap); }
143inline SV *to_sv (player * v) { return newSVattachable (v, "cf::player::wrap"); } 287inline SV *to_sv (player * v) { return newSVattachable (v, stash_cf_player_wrap); }
144inline SV *to_sv (object * v) { return newSVattachable (v, v && v->type == PLAYER ? "cf::object::player::wrap" : "cf::object::wrap"); } 288inline SV *to_sv (object * v) { return newSVattachable (v, v && v->type == PLAYER ? stash_cf_object_player_wrap : stash_cf_object_wrap); }
145inline SV *to_sv (maptile * v) { return newSVattachable (v, "cf::map::wrap"); } 289inline SV *to_sv (maptile * v) { return newSVattachable (v, stash_cf_map_wrap); }
146inline SV *to_sv (archetype * v) { return newSVptr (v, "cf::arch::wrap"); } 290inline SV *to_sv (archetype * v) { return newSVattachable (v, stash_cf_arch_wrap); }
147inline SV *to_sv (partylist * v) { return newSVptr (v, "cf::party::wrap"); } 291inline SV *to_sv (partylist * v) { return newSVptr (v, stash_cf_party_wrap); }
148inline SV *to_sv (region * v) { return newSVptr (v, "cf::region::wrap"); } 292inline SV *to_sv (region * v) { return newSVptr (v, stash_cf_region_wrap); }
149inline SV *to_sv (living * v) { return newSVptr (v, "cf::living::wrap"); } 293inline SV *to_sv (living * v) { return newSVptr (v, stash_cf_living_wrap); }
150 294
151inline SV *to_sv (object & v) { return to_sv (&v); } 295inline SV *to_sv (object & v) { return to_sv (&v); }
152inline SV *to_sv (living & v) { return to_sv (&v); } 296inline SV *to_sv (living & v) { return to_sv (&v); }
153 297
154//TODO: 298//TODO:
… …
207 351
208 if (2 != sscanf (SvPV_nolen (sv), "<%d.%" SCNx64 ">", &version, &v.seq) || 1 != version) 352 if (2 != sscanf (SvPV_nolen (sv), "<%d.%" SCNx64 ">", &version, &v.seq) || 1 != version)
209 croak ("unparsable uuid: %s", SvPV_nolen (sv)); 353 croak ("unparsable uuid: %s", SvPV_nolen (sv));
210} 354}
211 355
212inline void sv_to (SV *sv, object::flags_t::reference v) { v = boolSV (sv); } 356inline void sv_to (SV *sv, object::flags_t::reference v) { v = SvTRUE (sv); }
213 357
214static SV * 358static SV *
215newSVdt_va (va_list &ap, data_type type) 359newSVdt_va (va_list &ap, data_type type)
216{ 360{
217 SV *sv; 361 SV *sv;
… …
324} 468}
325 469
326////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 470//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
327 471
328SV * 472SV *
329registry (attachable_base *ext) 473registry (attachable *ext)
330{ 474{
331 if (!ext->cb) 475 if (!ext->cb)
332 ext->cb = newAV (); 476 ext->cb = newAV ();
333 477
334 return newRV_inc ((SV *)ext->cb); 478 return newRV_inc ((SV *)ext->cb);
335} 479}
336 480
481#if 0
337void attachable_base::clear () 482void attachable::clear ()
338{ 483{
339 if (self) 484 if (self)
340 { 485 {
341 if (cb)
342 if (SvROK (*av_fetch (cb, EVENT_OBJECT_DESTROY, 1)))
343 INVOKE_OBJECT (DESTROY, static_cast<object *>(this));
344 else if (SvROK (*av_fetch (cb, EVENT_MAP_DESTROY, 1)))
345 INVOKE_MAP (DESTROY, static_cast<maptile *>(this));
346
347 // disconnect Perl from C, to avoid crashes 486 // disconnect Perl from C, to avoid crashes
348 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext); 487 sv_unmagic (SvRV ((SV *)self), PERL_MAGIC_ext);
349 488
350 // clear the perl hash, might or might not be a good idea 489 // clear the perl hash, might or might not be a good idea
351 hv_clear ((HV *)SvRV ((SV *)self)); 490 hv_clear ((HV *)SvRV ((SV *)self));
… …
360 cb = 0; 499 cb = 0;
361 } 500 }
362 501
363 attach = 0; 502 attach = 0;
364} 503}
504#endif
365 505
366void attachable_base::optimise () 506void attachable::optimise ()
367{ 507{
368 if (!self) 508 if (self
369 return;
370
371 HV *hv = (HV *)SvRV ((SV *)self);
372
373 if (SvREFCNT ((SV *)self) == 1
374 && SvREFCNT ((SV *)hv) == 1 509 && SvREFCNT (self) == 1
375 && !HvTOTALKEYS (hv)) 510 && !HvTOTALKEYS (self))
376 { 511 {
512 flags &= ~F_BORROWED;
513 refcnt_inc ();
377 SvREFCNT_dec ((SV *)self); 514 SvREFCNT_dec ((SV *)self);
378 self = 0;
379 }
380}
381
382void attachable_base::instantiate (data_type type, void *obj)
383{
384 dSP;
385 ENTER;
386 SAVETMPS;
387 PUSHMARK (SP);
388 EXTEND (SP, 2);
389 PUSHs (sv_2mortal (newSVdt (type, obj)));
390 PUSHs (sv_2mortal (newSVpv (attach, 0)));
391
392 attach = 0;
393
394 PUTBACK;
395 call_pv ("cf::instantiate", G_DISCARD | G_VOID | G_EVAL);
396 FREETMPS;
397 LEAVE;
398
399 switch (type)
400 {
401 case DT_OBJECT: INVOKE_OBJECT (INSTANTIATE, obj); break;
402 case DT_MAP: INVOKE_MAP (INSTANTIATE, obj); break;
403 } 515 }
404} 516}
405 517
406///////////////////////////////////////////////////////////////////////////// 518/////////////////////////////////////////////////////////////////////////////
407
408void reattach (data_type type, void *obj)
409{
410 //TODO only do this when the object has _attachment's
411
412 dSP;
413 ENTER;
414 SAVETMPS;
415 PUSHMARK (SP);
416 XPUSHs (sv_2mortal (newSVdt (type, obj)));
417 PUTBACK;
418 call_pv ("cf::reattach", G_DISCARD | G_VOID | G_EVAL);
419 FREETMPS;
420 LEAVE;
421
422 switch (type)
423 {
424 case DT_OBJECT: INVOKE_OBJECT (REATTACH, obj); break;
425 case DT_PLAYER: INVOKE_PLAYER (REATTACH, obj); break;
426 case DT_CLIENT: INVOKE_CLIENT (REATTACH, obj); break;
427 case DT_MAP: INVOKE_MAP (REATTACH, obj); break;
428 }
429}
430
431template<class subclass>
432void reattach (attachable<subclass> *obj)
433{
434 obj->optimise ();
435
436 if (obj->self)
437 reattach ((data_type) cftype<subclass>::dt, (subclass *)obj);
438}
439 519
440#include "kw_hash.h" 520#include "kw_hash.h"
441 521
442object_freezer::object_freezer () 522object_freezer::object_freezer ()
443: dynbuf (128 * 1024, 64 * 1024) 523: dynbuf (128 * 1024, 64 * 1024)
… …
448object_freezer::~object_freezer () 528object_freezer::~object_freezer ()
449{ 529{
450 SvREFCNT_dec (av); 530 SvREFCNT_dec (av);
451} 531}
452 532
453void object_freezer::put (attachable_base *ext) 533void object_freezer::put (attachable *ext)
454{ 534{
455 ext->optimise (); 535 ext->optimise ();
456 536
457 if (ext->self) 537 if (ext->self)
458 { 538 {
459 int idx = AvFILLp ((AV *)av) + 1; 539 int idx = AvFILLp ((AV *)av) + 1;
460 av_store (av, idx, SvREFCNT_inc (ext->self)); 540 av_store (av, idx, newRV_inc ((SV *)ext->self));
461 541
462 add ((void *)"oid ", 4); 542 add ((void *)"oid ", 4);
463 add ((sint32)idx); 543 add ((sint32)idx);
464 add ('\n'); 544 add ('\n');
465 } 545 }
… …
577 text = newSVpv (data, 0); 657 text = newSVpv (data, 0);
578 sv_catpv (text, thawer_eof); 658 sv_catpv (text, thawer_eof);
579 line = SvPVbyte_nolen (text); 659 line = SvPVbyte_nolen (text);
580} 660}
581 661
582void object_thawer::get (data_type type, void *obj, attachable_base *ext, int oid) 662void object_thawer::get (attachable *obj, int oid)
583{ 663{
584 if (!av || oid < 0) // this is actually an error of sorts 664 if (!av || oid < 0) // this is actually an error of sorts
585 return; 665 return;
586 666
587 // we have to "re-instantiate"/reattach to an object, so nuke ext->attach 667 // object must be virgin
588 ext->clear (); 668 assert (!obj->self);
589 669
590 SV **svp = av_fetch ((AV *)av, oid, 0); 670 SV **svp = av_fetch ((AV *)av, oid, 0);
591 671
592 if (!svp || !SvROK (*svp)) 672 if (!svp || !SvROK (*svp))
593 { 673 {
594 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid); 674 printf ("trying to thaw duplicate or never-issued oid %d, ignoring.\n", oid);
595 return; 675 return;
596 } 676 }
597 677
598 ext->self = *svp; *svp = &PL_sv_undef; 678 obj->self = (HV *)SvRV (*svp);
599 sv_magic (SvRV (ext->self), 0, PERL_MAGIC_ext, (char *)obj, 0); 679 SvRV_set (*svp, &PL_sv_undef);
600 680
601 reattach (type, obj); 681 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &vtbl_attachable, (char *)obj, 0);
682 obj->reattach ();
683
684 // borrow a refcount for the perl object
685 obj->flags |= attachable::F_BORROWED;
686 obj->refcnt_dec ();
602} 687}
603 688
604object_thawer::~object_thawer () 689object_thawer::~object_thawer ()
605{ 690{
606 if (text) SvREFCNT_dec (text); 691 if (text) SvREFCNT_dec (text);
… …
864 dSP; 949 dSP;
865 950
866 PUSHMARK (SP); 951 PUSHMARK (SP);
867 PUTBACK; 952 PUTBACK;
868 call_pv ("cf::main", G_DISCARD | G_VOID); 953 call_pv ("cf::main", G_DISCARD | G_VOID);
954}
955
956void
957attachable::instantiate ()
958{
959 if (attach)
960 {
961 invoke (EVENT_ATTACHABLE_INSTANTIATE, ARG_STRING (attach), DT_END);
962 attach = 0;
963 }
964}
965
966void
967attachable::reattach ()
968{
969 optimise ();
970 //TODO: check for _attachment's, very important for restarts
971 invoke (EVENT_ATTACHABLE_REATTACH, DT_END);
869} 972}
870 973
871static event_klass klass_of[NUM_EVENT_TYPES] = { 974static event_klass klass_of[NUM_EVENT_TYPES] = {
872# define def(type,name) KLASS_ ## type, 975# define def(type,name) KLASS_ ## type,
873# include "eventinc.h" 976# include "eventinc.h"
… …
904 } 1007 }
905 } 1008 }
906 } 1009 }
907} 1010}
908 1011
1012void
1013attachable::gather_callbacks (AV *&callbacks, event_type event) const
1014{
1015 ::gather_callbacks (callbacks, cb_attachable, event);
1016
1017 if (cb)
1018 ::gather_callbacks (callbacks, cb, event);
1019}
1020
1021void
1022global::gather_callbacks (AV *&callbacks, event_type event) const
1023{
1024 ::gather_callbacks (callbacks, cb_object, event);
1025}
1026
1027void
1028object::gather_callbacks (AV *&callbacks, event_type event) const
1029{
1030 if (subtype && type + subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
1031 {
1032 SV *registry = AvARRAY (cb_type)[type + subtype * NUM_SUBTYPES];
1033
1034 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
1035 ::gather_callbacks (callbacks, (AV *)SvRV (registry), event);
1036 }
1037
1038 if (type <= AvFILLp (cb_type))
1039 {
1040 SV *registry = AvARRAY (cb_type)[type];
1041
1042 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
1043 ::gather_callbacks (callbacks, (AV *)SvRV (registry), event);
1044 }
1045
1046 attachable::gather_callbacks (callbacks, event);
1047 ::gather_callbacks (callbacks, cb_object, event);
1048}
1049
1050void
1051archetype::gather_callbacks (AV *&callbacks, event_type event) const
1052{
1053 attachable::gather_callbacks (callbacks, event);
1054 //TODO//::gather_callbacks (callbacks, cb_archetype, event);
1055}
1056
1057void
1058client::gather_callbacks (AV *&callbacks, event_type event) const
1059{
1060 attachable::gather_callbacks (callbacks, event);
1061 ::gather_callbacks (callbacks, cb_client, event);
1062}
1063
1064void
1065player::gather_callbacks (AV *&callbacks, event_type event) const
1066{
1067 attachable::gather_callbacks (callbacks, event);
1068 ::gather_callbacks (callbacks, cb_player, event);
1069}
1070
1071void
1072maptile::gather_callbacks (AV *&callbacks, event_type event) const
1073{
1074 attachable::gather_callbacks (callbacks, event);
1075 ::gather_callbacks (callbacks, cb_map, event);
1076}
1077
1078bool
909bool cfperl_invoke (event_type event, ...) 1079attachable::invoke (event_type event, ...)
910{ 1080{
911 data_type dt; 1081 data_type dt;
912 va_list ap; 1082 va_list ap;
913 1083
914 va_start (ap, event); 1084 va_start (ap, event);
915 1085
916 AV *callbacks = 0;
917
918 object *op;
919 player *pl;
920 maptile *map;
921 client *ns;
922
923 // callback call ordering is: 1086 // callback call ordering should be:
924 // 1. per-object callback 1087 // 1. per-object callback
925 // 2. per-class object 1088 // 2. per-class object
926 // 3. per-type callback 1089 // 3. per-type callback
927 // 4. global callbacks 1090 // 4. global callbacks
928 1091
1092 AV *callbacks = 0;
929 gather_callbacks (callbacks, cb_global, event); 1093 gather_callbacks (callbacks, event);
930
931 switch (KLASS_OF (event))
932 {
933 case KLASS_GLOBAL:
934 break;
935
936 case KLASS_OBJECT:
937 dt = (data_type) va_arg (ap, int);
938 assert (("first argument must be of type object", dt == DT_OBJECT));
939 op = va_arg (ap, object *);
940
941 if (op->cb)
942 gather_callbacks (callbacks, op->cb, event);
943
944 if (op->type)
945 {
946 if (op->subtype && op->type + op->subtype * NUM_SUBTYPES <= AvFILLp (cb_type))
947 {
948 SV *registry = AvARRAY (cb_type)[op->type + op->subtype * NUM_SUBTYPES];
949
950 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
951 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
952 }
953
954 if (op->type <= AvFILLp (cb_type))
955 {
956 SV *registry = AvARRAY (cb_type)[op->type];
957
958 if (registry && SvROK (registry) && SvTYPE (SvRV (registry)) == SVt_PVAV)
959 gather_callbacks (callbacks, (AV *)SvRV (registry), event);
960 }
961 }
962
963 gather_callbacks (callbacks, cb_object, event);
964
965 break;
966
967 case KLASS_PLAYER:
968 dt = (data_type) va_arg (ap, int);
969 assert (("first argument must be of type player", dt == DT_PLAYER));
970 pl = va_arg (ap, player *);
971
972 if (pl->cb)
973 gather_callbacks (callbacks, pl->cb, event);
974
975 gather_callbacks (callbacks, cb_player, event);
976 break;
977
978 case KLASS_MAP:
979 dt = (data_type) va_arg (ap, int);
980 assert (("first argument must be of type object", dt == DT_MAP));
981 map = va_arg (ap, maptile *);
982
983 if (map->cb)
984 gather_callbacks (callbacks, map->cb, event);
985
986 gather_callbacks (callbacks, cb_map, event);
987 break;
988
989 case KLASS_CLIENT:
990 dt = (data_type) va_arg (ap, int);
991 assert (("first argument must be of type client", dt == DT_CLIENT));
992 ns = va_arg (ap, client *);
993
994 if (ns->cb)
995 gather_callbacks (callbacks, ns->cb, event);
996
997 gather_callbacks (callbacks, cb_client, event);
998 break;
999
1000 default:
1001 assert (("unsupported event klass in cfperl_invoke", 0));
1002 }
1003 1094
1004 // short-circuit processing if no callbacks found/defined 1095 // short-circuit processing if no callbacks found/defined
1005 if (!callbacks) 1096 if (!callbacks)
1006 return 0; 1097 return 0;
1007 1098
… …
1013 EXTEND (SP, 3); 1104 EXTEND (SP, 3);
1014 1105
1015 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays 1106 PUSHs (sv_2mortal (newSViv (event))); // only used for debugging nowadays
1016 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks))); 1107 PUSHs (sv_2mortal (newRV_noinc ((SV *)callbacks)));
1017 1108
1018 switch (KLASS_OF (event)) 1109 //TODO: unhack
1019 { 1110 if (object *op = is_a<object>(this)) PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op)));
1020 case KLASS_OBJECT: PUSHs (sv_2mortal (newSVdt (DT_OBJECT, op))); break; 1111 else if (player *pl = is_a<player>(this)) PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl)));
1021 case KLASS_PLAYER: PUSHs (sv_2mortal (newSVdt (DT_PLAYER, pl))); break; 1112 else if (client *ns = is_a<client>(this)) PUSHs (sv_2mortal (newSVdt (DT_CLIENT, ns)));
1022 case KLASS_CLIENT: PUSHs (sv_2mortal (newSVdt (DT_CLIENT, ns))); break; 1113 else if (maptile *m = is_a<maptile>(this)) PUSHs (sv_2mortal (newSVdt (DT_MAP, m)));
1023 case KLASS_MAP: PUSHs (sv_2mortal (newSVdt (DT_MAP, map))); break; 1114 else if (global *gl = is_a<global>(this)) /*nop*/;
1024 } 1115 else
1116 abort (); //TODO
1025 1117
1026 for (;;) 1118 for (;;)
1027 { 1119 {
1028 dt = (data_type) va_arg (ap, int); 1120 dt = (data_type) va_arg (ap, int);
1029 1121
1030 if (dt == DT_END) 1122 if (dt == DT_END)
1031 break; 1123 break;
1032
1033 if (dt == DT_AV) 1124 else if (dt == DT_AV)
1034 { 1125 {
1035 AV *av = va_arg (ap, AV *); 1126 AV *av = va_arg (ap, AV *);
1036 1127
1037 for (int i = 0; i <= av_len (av); ++i) 1128 for (int i = 0; i <= av_len (av); ++i)
1038 XPUSHs (*av_fetch (av, i, 1)); 1129 XPUSHs (*av_fetch (av, i, 1));
… …
1139 pe->poll = events; 1230 pe->poll = events;
1140 if (pe->poll) start (); 1231 if (pe->poll) start ();
1141 } 1232 }
1142} 1233}
1143 1234
1235void
1236_connect_to_perl ()
1237{
1238 stash_cf = gv_stashpv ("cf" , 1);
1239
1240 stash_cf_object_wrap = gv_stashpv ("cf::object::wrap", 1);
1241 stash_cf_object_player_wrap = gv_stashpv ("cf::object::player::wrap", 1);
1242 stash_cf_player_wrap = gv_stashpv ("cf::player::wrap", 1);
1243 stash_cf_map_wrap = gv_stashpv ("cf::map::wrap" , 1);
1244 stash_cf_client_wrap = gv_stashpv ("cf::client::wrap", 1);
1245 stash_cf_arch_wrap = gv_stashpv ("cf::arch::wrap" , 1);
1246 stash_cf_party_wrap = gv_stashpv ("cf::party::wrap" , 1);
1247 stash_cf_region_wrap = gv_stashpv ("cf::region::wrap", 1);
1248 stash_cf_living_wrap = gv_stashpv ("cf::living::wrap", 1);
1249
1250 cb_global = get_av ("cf::CB_GLOBAL", 1);
1251 cb_attachable = get_av ("cf::CB_ATTACHABLE", 1);
1252 cb_object = get_av ("cf::CB_OBJECT", 1);
1253 cb_player = get_av ("cf::CB_PLAYER", 1);
1254 cb_client = get_av ("cf::CB_CLIENT", 1);
1255 cb_type = get_av ("cf::CB_TYPE" , 1);
1256 cb_map = get_av ("cf::CB_MAP" , 1);
1257}
1258
1144MODULE = cf PACKAGE = cf PREFIX = cf_ 1259MODULE = cf PACKAGE = cf PREFIX = cf_
1145 1260
1146BOOT: 1261BOOT:
1147{ 1262{
1148 HV *stash = gv_stashpv ("cf", 1); 1263 _connect_to_perl ();
1149 1264
1150 I_EVENT_API (PACKAGE); 1265 I_EVENT_API (PACKAGE);
1151 watcher_base::GEventAPI = GEventAPI; 1266 watcher_base::GEventAPI = GEventAPI;
1152 I_CORO_API (PACKAGE); 1267 I_CORO_API (PACKAGE);
1153 1268
1154 newCONSTSUB (stash, "VERSION", newSVpv (VERSION, sizeof (VERSION) - 1)); 1269 newCONSTSUB (stash_cf, "VERSION", newSVpv (VERSION, sizeof (VERSION) - 1));
1155 1270
1156 static const struct { 1271 static const struct {
1157 const char *name; 1272 const char *name;
1158 IV iv; 1273 IV iv;
1159 } *civ, const_iv[] = { 1274 } *civ, const_iv[] = {
… …
1625 const_iv (MAP_IN_MEMORY) 1740 const_iv (MAP_IN_MEMORY)
1626 const_iv (MAP_SWAPPED) 1741 const_iv (MAP_SWAPPED)
1627 const_iv (MAP_LOADING) 1742 const_iv (MAP_LOADING)
1628 const_iv (MAP_SAVING) 1743 const_iv (MAP_SAVING)
1629 1744
1745 const_iv (KLASS_ATTACHABLE)
1630 const_iv (KLASS_GLOBAL) 1746 const_iv (KLASS_GLOBAL)
1631 const_iv (KLASS_OBJECT) 1747 const_iv (KLASS_OBJECT)
1632 const_iv (KLASS_CLIENT) 1748 const_iv (KLASS_CLIENT)
1633 const_iv (KLASS_PLAYER) 1749 const_iv (KLASS_PLAYER)
1634 const_iv (KLASS_MAP) 1750 const_iv (KLASS_MAP)
… …
1646 const_iv (ST_CONFIRM_QUIT) 1762 const_iv (ST_CONFIRM_QUIT)
1647 const_iv (ST_GET_PARTY_PASSWORD) 1763 const_iv (ST_GET_PARTY_PASSWORD)
1648 }; 1764 };
1649 1765
1650 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; ) 1766 for (civ = const_iv + sizeof (const_iv) / sizeof (const_iv [0]); civ-- > const_iv; )
1651 newCONSTSUB (stash, (char *)civ->name, newSViv (civ->iv)); 1767 newCONSTSUB (stash_cf, (char *)civ->name, newSViv (civ->iv));
1652 1768
1653 static const struct { 1769 static const struct {
1654 const char *name; 1770 const char *name;
1655 int skip; 1771 int skip;
1656 IV klass; 1772 IV klass;
… …
1667 { 1783 {
1668 AV *event = newAV (); 1784 AV *event = newAV ();
1669 av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0)); 1785 av_push (event, newSVpv ((char *)eiv->name + eiv->skip, 0));
1670 av_push (event, newSViv (eiv->klass)); 1786 av_push (event, newSViv (eiv->klass));
1671 av_store (av, eiv->iv, newRV_noinc ((SV *)event)); 1787 av_store (av, eiv->iv, newRV_noinc ((SV *)event));
1672 newCONSTSUB (stash, (char *)eiv->name, newSViv (eiv->iv)); 1788 newCONSTSUB (stash_cf, (char *)eiv->name, newSViv (eiv->iv));
1673 } 1789 }
1674} 1790}
1675 1791
1676void _init_vars () 1792void _connect_to_perl ()
1677 CODE:
1678 cb_global = get_av ("cf::CB_GLOBAL", 1);
1679 cb_object = get_av ("cf::CB_OBJECT", 1);
1680 cb_player = get_av ("cf::CB_PLAYER", 1);
1681 cb_client = get_av ("cf::CB_CLIENT", 1);
1682 cb_type = get_av ("cf::CB_TYPE" , 1);
1683 cb_map = get_av ("cf::CB_MAP" , 1);
1684 1793
1685void _global_reattach () 1794void _global_reattach ()
1686 CODE: 1795 CODE:
1687{ 1796{
1688 // reattach to all attachable objects in the game. 1797 // reattach to all attachable objects in the game.
1689 for (sockvec::iterator i = clients.begin (); i != clients.end (); ++i) 1798 for (sockvec::iterator i = clients.begin (); i != clients.end (); ++i)
1690 reattach (*i); 1799 (*i)->reattach ();
1691 1800
1692 for (player *pl = first_player; pl; pl = pl->next) 1801 for (player *pl = first_player; pl; pl = pl->next)
1693 reattach (pl); 1802 pl->reattach ();
1694 1803
1695 for (maptile *map = first_map; map; map = map->next) 1804 for (maptile *m = first_map; m; m = m->next)
1696 reattach (map); 1805 m->reattach ();
1697 1806
1698 for (object *op = object::first; op; op = op->next) 1807 for (object *op = object::first; op; op = op->next)
1699 reattach (op); 1808 op->reattach ();
1700} 1809}
1701 1810
1702NV floor (NV x) 1811NV floor (NV x)
1703 1812
1704NV ceil (NV x) 1813NV ceil (NV x)
… …
1815int invoke (SV *klass, int event, ...) 1924int invoke (SV *klass, int event, ...)
1816 CODE: 1925 CODE:
1817 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL"); 1926 if (KLASS_OF (event) != KLASS_GLOBAL) croak ("event class must be GLOBAL");
1818 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 1927 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1819 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 1928 for (int i = 1; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1820 RETVAL = INVOKE_((event_type)event, ARG_AV (av)); 1929 RETVAL = gbl_ev.invoke ((event_type)event, ARG_AV (av), DT_END);
1821 OUTPUT: RETVAL 1930 OUTPUT: RETVAL
1822 1931
1823MODULE = cf PACKAGE = cf::object PREFIX = cf_object_ 1932MODULE = cf PACKAGE = cf::object PREFIX = cf_object_
1824 1933
1825INCLUDE: $PERL genacc object ../include/object.h | 1934INCLUDE: $PERL genacc object ../include/object.h |
… …
1827int invoke (object *op, int event, ...) 1936int invoke (object *op, int event, ...)
1828 CODE: 1937 CODE:
1829 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT"); 1938 if (KLASS_OF (event) != KLASS_OBJECT) croak ("event class must be OBJECT");
1830 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 1939 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
1831 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 1940 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
1832 RETVAL = INVOKE_((event_type)event, ARG_OBJECT (op), ARG_AV (av)); 1941 RETVAL = op->invoke ((event_type)event, ARG_AV (av), DT_END);
1833 OUTPUT: RETVAL 1942 OUTPUT: RETVAL
1834 1943
1835SV *registry (object *op) 1944SV *registry (object *op)
1836 1945
1837void mortals () 1946void mortals ()
… …
1891 2000
1892object *find_best_object_match (object *op, const char *match) 2001object *find_best_object_match (object *op, const char *match)
1893 2002
1894object *find_marked_object (object *op) 2003object *find_marked_object (object *op)
1895 2004
1896int need_identify (const object *obj); 2005int need_identify (object *obj);
1897 2006
1898int apply_shop_mat (object *shop_mat, object *op); 2007int apply_shop_mat (object *shop_mat, object *op);
1899 2008
1900int move (object *op, int dir, object *originator = op) 2009int move (object *op, int dir, object *originator = op)
1901 CODE: 2010 CODE:
… …
1914void remove (object *op) 2023void remove (object *op)
1915 CODE: 2024 CODE:
1916 op->remove (); 2025 op->remove ();
1917 2026
1918void 2027void
1919object::destroy (int recursive = 0) 2028object::destroy (bool destroy_inventory = false)
2029
2030void
2031object::destroy_inv (bool drop_to_ground = false)
1920 2032
1921object *cf_object_present_archname_inside (object *op, char *whatstr) 2033object *cf_object_present_archname_inside (object *op, char *whatstr)
1922 2034
1923int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0) 2035int cf_object_transfer (object *op, int x, int y, int r = 0, object_ornull *orig = 0)
1924 2036
… …
2137int invoke (player *pl, int event, ...) 2249int invoke (player *pl, int event, ...)
2138 CODE: 2250 CODE:
2139 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER"); 2251 if (KLASS_OF (event) != KLASS_PLAYER) croak ("event class must be PLAYER");
2140 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 2252 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2141 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 2253 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2142 RETVAL = INVOKE_((event_type)event, ARG_PLAYER (pl), ARG_AV (av)); 2254 RETVAL = pl->invoke ((event_type)event, ARG_AV (av), DT_END);
2143 OUTPUT: RETVAL 2255 OUTPUT: RETVAL
2144 2256
2145SV *registry (player *pl) 2257SV *registry (player *pl)
2146 2258
2147player * 2259player *
… …
2266int invoke (maptile *map, int event, ...) 2378int invoke (maptile *map, int event, ...)
2267 CODE: 2379 CODE:
2268 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP"); 2380 if (KLASS_OF (event) != KLASS_MAP) croak ("event class must be MAP");
2269 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 2381 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2270 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 2382 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2271 RETVAL = INVOKE_((event_type)event, ARG_MAP (map), ARG_AV (av)); 2383 RETVAL = map->invoke ((event_type)event, ARG_AV (av), DT_END);
2272 OUTPUT: RETVAL 2384 OUTPUT: RETVAL
2273 2385
2274SV *registry (maptile *map) 2386SV *registry (maptile *map)
2275 2387
2276INCLUDE: $PERL genacc maptile ../include/map.h | 2388INCLUDE: $PERL genacc maptile ../include/map.h |
… …
2495int invoke (client *ns, int event, ...) 2607int invoke (client *ns, int event, ...)
2496 CODE: 2608 CODE:
2497 if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT"); 2609 if (KLASS_OF (event) != KLASS_CLIENT) croak ("event class must be CLIENT");
2498 AV *av = (AV *)sv_2mortal ((SV *)newAV ()); 2610 AV *av = (AV *)sv_2mortal ((SV *)newAV ());
2499 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i))); 2611 for (int i = 2; i < items; i++) av_push (av, SvREFCNT_inc (ST (i)));
2500 RETVAL = INVOKE_((event_type)event, ARG_CLIENT (ns), ARG_AV (av)); 2612 RETVAL = ns->invoke ((event_type)event, ARG_AV (av), DT_END);
2501 OUTPUT: RETVAL 2613 OUTPUT: RETVAL
2502 2614
2503SV *registry (client *ns) 2615SV *registry (client *ns)
2504 2616
2505void 2617void

Diff Legend

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