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.154 by root, Fri Jan 26 21:44:11 2007 UTC vs.
Revision 1.166 by root, Tue Feb 13 19:25:45 2007 UTC

… …
29#include <plugin_common.h> 29#include <plugin_common.h>
30#include <sounds.h> 30#include <sounds.h>
31#include <cstdarg> 31#include <cstdarg>
32#include <sproto.h> 32#include <sproto.h>
33 33
34#include "loader.h"
34#include "cfperl.h" 35#include "cfperl.h"
35#include "shstr.h" 36#include "shstr.h"
36 37
37#include <unistd.h> 38#include <unistd.h>
38#if _POSIX_MEMLOCK 39#if _POSIX_MEMLOCK
… …
112{ 113{
113 return refcnt + (self ? SvREFCNT (self) - 1 : 0); 114 return refcnt + (self ? SvREFCNT (self) - 1 : 0);
114} 115}
115 116
116void 117void
118attachable::sever_self ()
119{
120 if (HV *self = this->self)
121 {
122 // keep a refcount because sv_unmagic might call attachable_free,
123 // which might clear self, causing sv_unmagic to crash on a now
124 // invalid object.
125 SvREFCNT_inc (self);
126 hv_clear (self);
127 sv_unmagic ((SV *)self, PERL_MAGIC_ext);
128 SvREFCNT_dec (self);
129
130 // self *must* be null now because thats sv_unmagic's job.
131 assert (!this->self);
132 flags |= 0x80; // severed //D
133 }
134}
135
136void
117attachable::optimise () 137attachable::optimise ()
118{ 138{
119 if (self 139 if (self
120 && SvREFCNT (self) == 1 140 && SvREFCNT (self) == 1
121 && !HvTOTALKEYS (self)) 141 && !HvTOTALKEYS (self))
122 { 142 flags |= 0x40,//D
123 SV *self = (SV *)this->self; 143 sever_self ();
124
125 SvREFCNT_inc (self);
126 sv_unmagic (self, PERL_MAGIC_ext);
127 SvREFCNT_dec (self);
128 assert (!this->self);
129 }
130} 144}
131 145
132// check wether the object really is dead 146// check wether the object really is dead
133void 147void
134attachable::do_check () 148attachable::do_check ()
… …
149 SvREFCNT_dec (cb); 163 SvREFCNT_dec (cb);
150 cb = 0; 164 cb = 0;
151 } 165 }
152 166
153 if (self) 167 if (self)
154 { 168 sever_self ();
155 hv_clear (self);
156 169
157 SV *self = (SV *)this->self; 170 flags |= 0x20; //D
158 SvREFCNT_inc (self);
159 sv_unmagic (self, PERL_MAGIC_ext);
160 SvREFCNT_dec (self);
161 // self is now 0
162 assert (!this->self);//D//TODO remove soon
163 }
164
165 mortals.push_back (this); 171 mortals.push_back (this);
166} 172}
167 173
168void 174void
169attachable::destroy () 175attachable::destroy ()
… …
264 270
265 if (!obj->self) 271 if (!obj->self)
266 { 272 {
267 obj->self = newHV (); 273 obj->self = newHV ();
268 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0); 274 sv_magicext ((SV *)obj->self, 0, PERL_MAGIC_ext, &attachable::vtbl, (char *)obj, 0);
275 obj->flags |= (obj->flags & 0xc0) << 8;
276 obj->flags &= ~0xc0;//D
277 obj->flags |= 0x10;//D
269 278
270 // now bless the object _once_ 279 // now bless the object _once_
271 return sv_bless (newRV_inc ((SV *)obj->self), stash); 280 return sv_bless (newRV_inc ((SV *)obj->self), stash);
272 } 281 }
273 else 282 else
… …
345inline SV *to_sv (treasurelist * v) { return to_sv (v->name); } 354inline SV *to_sv (treasurelist * v) { return to_sv (v->name); }
346 355
347inline SV *to_sv (UUID v) 356inline SV *to_sv (UUID v)
348{ 357{
349 char buf[128]; 358 char buf[128];
350 snprintf (buf, 128, "<1,%" PRIx64 ">", v.seq); 359 snprintf (buf, 128, "<1.%" PRIx64 ">", v.seq);
351 return newSVpv (buf, 0); 360 return newSVpv (buf, 0);
352} 361}
353 362
354inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; } 363inline void sv_to (SV *sv, shstr &v) { v = SvOK (sv) ? SvPV_nolen (sv) : 0; }
355inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; } 364inline void sv_to (SV *sv, char * &v) { free (v); v = SvOK (sv) ? strdup (SvPV_nolen (sv)) : 0; }
… …
602 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl)) 611 if (perl_parse (perl, xs_init, 2, argv, (char **)NULL) || perl_run (perl))
603 { 612 {
604 printf ("unable to initialize perl-interpreter, aborting.\n"); 613 printf ("unable to initialize perl-interpreter, aborting.\n");
605 exit (EXIT_FAILURE); 614 exit (EXIT_FAILURE);
606 } 615 }
616
617 {
618 dSP;
619
620 PUSHMARK (SP);
621 PUTBACK;
622 call_pv ("cf::init", G_DISCARD | G_VOID);
623 }
607} 624}
608 625
609void cfperl_main () 626void cfperl_main ()
610{ 627{
611 dSP; 628 dSP;
… …
829void 846void
830cfperl_emergency_save () 847cfperl_emergency_save ()
831{ 848{
832 CALL_BEGIN (0); 849 CALL_BEGIN (0);
833 CALL_CALL ("cf::emergency_save", G_VOID); 850 CALL_CALL ("cf::emergency_save", G_VOID);
851 CALL_END;
852}
853
854void
855cfperl_cleanup (int make_core)
856{
857 CALL_BEGIN (1);
858 CALL_ARG (make_core);
859 CALL_CALL ("cf::post_cleanup", G_VOID);
834 CALL_END; 860 CALL_END;
835} 861}
836 862
837maptile * 863maptile *
838maptile::find_sync (const char *path, maptile *origin) 864maptile::find_sync (const char *path, maptile *origin)
… …
1647 1673
1648void cleanup (const char *cause, bool make_core = false) 1674void cleanup (const char *cause, bool make_core = false)
1649 1675
1650void emergency_save () 1676void emergency_save ()
1651 1677
1678void _exit (int status = EXIT_SUCCESS)
1679
1652UV sv_2watcher (SV *w) 1680UV sv_2watcher (SV *w)
1653 CODE: 1681 CODE:
1654 RETVAL = (UV)GEventAPI->sv_2watcher (w); 1682 RETVAL = (UV)GEventAPI->sv_2watcher (w);
1655 OUTPUT: 1683 OUTPUT:
1656 RETVAL 1684 RETVAL
1657
1658void _exit (int status = 0)
1659 1685
1660#if _POSIX_MEMLOCK 1686#if _POSIX_MEMLOCK
1661 1687
1662int mlockall (int flags = MCL_CURRENT | MCL_FUTURE) 1688int mlockall (int flags = MCL_CURRENT | MCL_FUTURE)
1663 1689
… …
1709 RETVAL = newSVpv (resist_plus[atnr], 0); 1735 RETVAL = newSVpv (resist_plus[atnr], 0);
1710 else 1736 else
1711 XSRETURN_UNDEF; 1737 XSRETURN_UNDEF;
1712 OUTPUT: RETVAL 1738 OUTPUT: RETVAL
1713 1739
1740bool
1741load_regions (const char *filename)
1742 CODE:
1743 RETVAL = loader_region ().load (filename);
1744 OUTPUT: RETVAL
1745
1714MODULE = cf PACKAGE = cf::attachable 1746MODULE = cf PACKAGE = cf::attachable
1715 1747
1716int 1748int
1717valid (SV *obj) 1749valid (SV *obj)
1718 CODE: 1750 CODE:
1719 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext); 1751 RETVAL = SvROK (obj) && mg_find (SvRV (obj), PERL_MAGIC_ext);
1720 OUTPUT: 1752 OUTPUT:
1721 RETVAL 1753 RETVAL
1754
1755void
1756debug_trace (attachable *obj, bool on = true)
1757 CODE:
1758 obj->flags &= ~attachable::F_DEBUG_TRACE;
1759 if (on)
1760 obj->flags |= attachable::F_DEBUG_TRACE;
1722 1761
1723int mortals_size () 1762int mortals_size ()
1724 CODE: 1763 CODE:
1725 RETVAL = attachable::mortals.size (); 1764 RETVAL = attachable::mortals.size ();
1726 OUTPUT: RETVAL 1765 OUTPUT: RETVAL
… …
1802 1841
1803void 1842void
1804set_animation (object *op, int idx) 1843set_animation (object *op, int idx)
1805 CODE: 1844 CODE:
1806 SET_ANIMATION (op, idx); 1845 SET_ANIMATION (op, idx);
1846
1847int
1848num_animations (object *op)
1849 CODE:
1850 RETVAL = NUM_ANIMATIONS (op);
1851 OUTPUT: RETVAL
1807 1852
1808object *find_best_object_match (object *op, const char *match) 1853object *find_best_object_match (object *op, const char *match)
1809 1854
1810object *find_marked_object (object *op) 1855object *find_marked_object (object *op)
1811 1856
… …
2048 pl->orig_stats = pl->ob->stats; 2093 pl->orig_stats = pl->ob->stats;
2049 2094
2050void cf_player_move (player *pl, int dir) 2095void cf_player_move (player *pl, int dir)
2051 2096
2052void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0); 2097void play_sound_player_only (player *pl, int soundnum, int x = 0, int y = 0);
2053
2054player *first ()
2055 CODE:
2056 RETVAL = first_player;
2057 OUTPUT: RETVAL
2058 2098
2059bool 2099bool
2060cell_visible (player *pl, int dx, int dy) 2100cell_visible (player *pl, int dx, int dy)
2061 CODE: 2101 CODE:
2062 RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2 2102 RETVAL = FABS (dx) <= pl->ns->mapx / 2 && FABS (dy) <= pl->ns->mapy / 2
… …
2139 EXTEND (SP, THIS->players); 2179 EXTEND (SP, THIS->players);
2140 for_all_players (pl) 2180 for_all_players (pl)
2141 if (pl->ob && pl->ob->map == THIS) 2181 if (pl->ob && pl->ob->map == THIS)
2142 PUSHs (sv_2mortal (to_sv (pl->ob))); 2182 PUSHs (sv_2mortal (to_sv (pl->ob)));
2143 } 2183 }
2184
2185void
2186maptile::set_regiondata (SV *data, SV *plt)
2187 CODE:
2188{
2189 if (!SvROK (plt) || SvTYPE (SvRV (plt)) != SVt_PVAV)
2190 croak ("maptile::set_regiondata needs arrayref as plt arg");
2191
2192 AV *av = (AV *)SvRV (plt);
2193
2194 region **regionmap = (region **)malloc ((av_len (av) + 1) * sizeof (region *));
2195
2196 for (int i = av_len (av) + 1; i--; )
2197 regionmap [i] = region::find (SvPVutf8_nolen (*av_fetch (av, i, 1)));
2198
2199 THIS->regions = salloc<uint8_t> (THIS->size (), (uint8_t *)SvPVbyte_nolen (data));
2200 THIS->regionmap = regionmap;
2201}
2144 2202
2145void play_sound_map (maptile *map, int x, int y, int sound_num) 2203void play_sound_map (maptile *map, int x, int y, int sound_num)
2146 2204
2147int out_of_map (maptile *map, int x, int y) 2205int out_of_map (maptile *map, int x, int y)
2148 2206
… …
2229 OUTPUT: RETVAL 2287 OUTPUT: RETVAL
2230 2288
2231void fix_walls (maptile *map, int x, int y) 2289void fix_walls (maptile *map, int x, int y)
2232 2290
2233void fix_walls_around (maptile *map, int x, int y) 2291void fix_walls_around (maptile *map, int x, int y)
2234
2235const char *
2236region_name (maptile *m)
2237 CODE:
2238 RETVAL = get_name_of_region_for_map (m);
2239 OUTPUT: RETVAL
2240 2292
2241# worst xs function of my life 2293# worst xs function of my life
2242bool 2294bool
2243_create_random_map (\ 2295_create_random_map (\
2244 maptile *self,\ 2296 maptile *self,\
… …
2352 2404
2353INCLUDE: $PERL genacc partylist ../include/player.h | 2405INCLUDE: $PERL genacc partylist ../include/player.h |
2354 2406
2355MODULE = cf PACKAGE = cf::region 2407MODULE = cf PACKAGE = cf::region
2356 2408
2357region *first () 2409void
2358 PROTOTYPE: 2410list ()
2359 CODE: 2411 PPCODE:
2360 RETVAL = first_region; 2412 for_all_regions (rgn)
2361 OUTPUT: RETVAL 2413 XPUSHs (sv_2mortal (to_sv (rgn)));
2362 2414
2363region *find (char *name) 2415region *find (char *name)
2364 PROTOTYPE: $ 2416 PROTOTYPE: $
2365 CODE: 2417 CODE:
2366 RETVAL = get_region_by_name (name); 2418 RETVAL = region::find (name);
2419 OUTPUT: RETVAL
2420
2421region *find_fuzzy (char *name)
2422 PROTOTYPE: $
2423 CODE:
2424 RETVAL = region::find_fuzzy (name);
2367 OUTPUT: RETVAL 2425 OUTPUT: RETVAL
2368 2426
2369INCLUDE: $PERL genacc region ../include/map.h | 2427INCLUDE: $PERL genacc region ../include/map.h |
2370 2428
2371MODULE = cf PACKAGE = cf::living 2429MODULE = cf PACKAGE = cf::living

Diff Legend

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