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.68 by elmex, Sat Nov 18 23:16:19 2006 UTC vs.
Revision 1.71 by root, Mon Dec 11 21:37:29 2006 UTC

43extern sint64 *levels; // the experience table 43extern sint64 *levels; // the experience table
44 44
45typedef object object_ornull; 45typedef object object_ornull;
46typedef maptile maptile_ornull; 46typedef maptile maptile_ornull;
47 47
48#if IVSIZE >= 8
49 typedef IV val64;
50# define newSVval64 newSViv
51# define SvVAL64 SvIV
52#else
48typedef double val64; 53 typedef double val64;
49#define newSVval64 newSVnv 54# define newSVval64 newSVnv
50#define SvVAL64 SvNV 55# define SvVAL64 SvNV
56#endif
51 57
52static f_plug_api gethook = cfapi_get_hooks; 58static f_plug_api gethook = cfapi_get_hooks;
53static f_plug_api object_set_property = cfapi_object_set_property; 59static f_plug_api object_set_property = cfapi_object_set_property;
54static f_plug_api object_insert = cfapi_object_insert; 60static f_plug_api object_insert = cfapi_object_insert;
55 61
56static HV *obj_cache;
57static PerlInterpreter *perl; 62static PerlInterpreter *perl;
58 63
59static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map; 64static AV *cb_global, *cb_object, *cb_player, *cb_type, *cb_map;
60 65
61////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// 66//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
81 86
82 if (!obj->self) 87 if (!obj->self)
83 obj->self = newSVptr (obj, klass); 88 obj->self = newSVptr (obj, klass);
84 89
85 return newSVsv (obj->self); 90 return newSVsv (obj->self);
86}
87
88static void
89SVptr_cache_set (void *ptr, SV *sv)
90{
91 hv_store (obj_cache, (char *)&ptr, sizeof (ptr), sv, 0);
92}
93
94static SV *
95SVptr_cache_get (void *ptr)
96{
97 SV **he = hv_fetch (obj_cache, (char *)&ptr, sizeof (ptr), 0);
98
99 return he ? *he : 0;
100}
101
102static SV *
103newSVptr_cached (void *ptr, const char *klass)
104{
105 SV *sv;
106
107 if (!ptr)
108 return &PL_sv_undef;
109
110 sv = SVptr_cache_get (ptr);
111
112 if (!sv)
113 {
114 HV *hv = newHV ();
115 sv_magic ((SV *)hv, 0, PERL_MAGIC_ext, (char *)ptr, 0);
116 sv = sv_bless (newRV_noinc ((SV *)hv), gv_stashpv (klass, 1));
117
118 SVptr_cache_set (ptr, sv);
119 }
120
121 return newSVsv (sv);
122} 91}
123 92
124static void 93static void
125clearSVptr (SV *sv) 94clearSVptr (SV *sv)
126{ 95{
182 151
183//TODO: 152//TODO:
184inline SV *to_sv (New_Face * v) { return to_sv (v->name); } 153inline SV *to_sv (New_Face * v) { return to_sv (v->name); }
185inline SV *to_sv (treasurelist * v) { return to_sv (v->name); } 154inline SV *to_sv (treasurelist * v) { return to_sv (v->name); }
186 155
187inline SV *to_sv (UUID v) { 156inline SV *to_sv (UUID v)
157{
188 char buf[128]; 158 char buf[128];
189 snprintf (buf, 128, "<1,%llx>", (unsigned long long)v.seq + UUID_SKIP * 2); 159 snprintf (buf, 128, "<1,%" PRIx64 ">", v.seq);
190 return newSVpv (buf, 0); 160 return newSVpv (buf, 0);
191} 161}
192 162
193inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; } 163inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; }
194inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; } //TODO: verify that all simple pointers are strdup-managed 164inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; } //TODO: verify that all simple pointers are strdup-managed
220inline void sv_to (SV *sv, refptr<T> &v) { T *tmp; sv_to (sv, tmp); v = tmp; } 190inline void sv_to (SV *sv, refptr<T> &v) { T *tmp; sv_to (sv, tmp); v = tmp; }
221 191
222template<int N> 192template<int N>
223inline void sv_to (SV *sv, char (&v)[N]) { assign (v, SvPV_nolen (sv)); } 193inline void sv_to (SV *sv, char (&v)[N]) { assign (v, SvPV_nolen (sv)); }
224 194
225inline void sv_to (SV *sv, UUID &v) { 195inline void sv_to (SV *sv, UUID &v)
226 char *sv_str = SvOK (sv) ? SvPV_nolen (sv) : 0; 196{
227 unsigned int version = 0; 197 unsigned int version;
228 unsigned long long seq = 0;
229 198
230 if (!sv_str) 199 if (2 != sscanf (SvPV_nolen (sv), "<%d.%" SCNx64 ">", &version, &v.seq) || 1 != version)
231 return; 200 croak ("unparsable uuid: %s", SvPV_nolen (sv));
232
233 if (2 == sscanf (sv_str, "<%d.%llx>", &version, &seq) && version == 1)
234 {
235 v.seq = seq;
236 }
237
238 return;
239} 201}
240 202
241static SV * 203static SV *
242newSVdt_va (va_list &ap, data_type type) 204newSVdt_va (va_list &ap, data_type type)
243{ 205{
922 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 884 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
923 { 885 {
924 printf ("unable to initialize perl-interpreter, aborting.\n"); 886 printf ("unable to initialize perl-interpreter, aborting.\n");
925 exit (EXIT_FAILURE); 887 exit (EXIT_FAILURE);
926 } 888 }
927
928 obj_cache = newHV ();
929} 889}
930 890
931void cfperl_main () 891void cfperl_main ()
932{ 892{
933 dSP; 893 dSP;
2356 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break; 2316 case 7: RETVAL = newSVuv ( GET_MAP_MOVE_OFF (obj, x, y)); break;
2357 } 2317 }
2358 OUTPUT: 2318 OUTPUT:
2359 RETVAL 2319 RETVAL
2360 2320
2321void fix_walls (maptile *map, int x, int y)
2322
2323void fix_walls_around (maptile *map, int x, int y)
2361 2324
2362MODULE = cf PACKAGE = cf::arch 2325MODULE = cf PACKAGE = cf::arch
2363 2326
2364archetype *find (const char *name) 2327archetype *find (const char *name)
2365 CODE: 2328 CODE:

Diff Legend

Removed lines
+ Added lines
< Changed lines
> Changed lines