--- deliantra/server/include/cfperl.h	2006/12/25 11:25:49	1.41
+++ deliantra/server/include/cfperl.h	2007/01/23 03:56:45	1.51
@@ -13,9 +13,15 @@
 #include <XSUB.h>
 
 #include <EventAPI.h>
+#include <CoroAPI.h>
 
+#include "util.h"
+#include "keyword.h"
+#include "dynbuf.h"
 #include "callback.h"
 
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
 // optimisations/workaround for functions requiring my_perl in scope (anti-bloat)
 #undef localtime
 #undef srand48
@@ -30,14 +36,38 @@
 // same here, massive symbol spamming
 #undef do_open
 #undef do_close
+#undef ref
+#undef seed
 
 // perl bug #40256: perl does overwrite those with reentrant versions
 // but does not initialise their state structures.
 #undef random
 #undef crypt
 
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+// some macros to simplify perl in-calls
+
+#define CHECK_ERROR			\
+  if (SvTRUE (ERRSV))			\
+    LOG (llevError, "runtime error in %s: %s\n", __func__, SvPVutf8_nolen (ERRSV));
+
+#define CALL_BEGIN(args) dSP; ENTER; SAVETMPS; PUSHMARK (SP); EXTEND (SP, args)
+#define CALL_ARG_SV(sv) PUSHs (sv_2mortal (sv)) // separate because no refcount inc
+#define CALL_ARG(expr) PUSHs (sv_2mortal (to_sv (expr)))
+#define CALL_CALL(name, flags) PUTBACK; int count = call_pv (name, (flags) | G_EVAL); SPAGAIN;
+#define CALL_END CHECK_ERROR; FREETMPS; LEAVE
+
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
 void cfperl_init ();
 void cfperl_main ();
+void cfperl_emergency_save ();
+
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+// virtual server time, excluding time jumps and lag
+extern double runtime;
 
 enum event_klass
 {
@@ -91,33 +121,38 @@
 double cfperl_result_DOUBLE (int idx);
 int cfperl_result_INT (int idx);
 
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+INTERFACE_CLASS (attachable)
 struct attachable
 {
+  static MGVTBL vtbl;
+
   static unordered_vector<attachable *> mortals;
-  static void check_mortals ();
+  MTH static void check_mortals ();
 
   enum {
     F_DESTROYED = 0x01,
-    F_BORROWED  = 0x02,
   };
 
   // object is delete'd after the refcount reaches 0
-  mutable int refcnt;
-  int flags;
+  mutable int ACC (RW, refcnt);
+  int ACC (RW, flags);
 
-  void refcnt_inc () const { ++refcnt; }
-  void refcnt_dec () const { --refcnt; }
+  MTH void refcnt_inc () const { ++refcnt; }
+  MTH void refcnt_dec () const { --refcnt; }
 
+  MTH int refcnt_cnt () const;
   // check wether the object has died and destroy
-  void refcnt_chk () { if (refcnt <= 0) do_check (); }
+  MTH void refcnt_chk () { if (refcnt <= 0) do_check (); }
 
   // destroy the object unless it was already destroyed
   // this politely asks everybody interested the reduce
   // the refcount to 0 as soon as possible.
-  void destroy ();
+  MTH void destroy ();
 
   // return wether an object was destroyed already
-  bool destroyed () const { return flags & F_DESTROYED; }
+  MTH bool destroyed () const { return flags & F_DESTROYED; }
 
   virtual void gather_callbacks (AV *&callbacks, event_type event) const;
 
@@ -148,7 +183,7 @@
   attachable &operator =(const attachable &src);
 
   bool invoke (event_type event, ...);
-  void instantiate ();
+  MTH void instantiate ();
   void reattach ();
 
 protected:
@@ -167,6 +202,8 @@
 
 extern struct global gbl_ev;
 
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
 struct object_freezer : dynbuf
 {
   AV *av;
@@ -215,7 +252,7 @@
     *p = '\n';
   }
 
-  void put (keyword k, const char *v)
+  void put (keyword k, const char *v = 0)
   {
     put_string (k, v);
   }
@@ -290,7 +327,7 @@
     put (k, (T *)v);
   }
 
-  bool save (const char *filename);
+  bool save (const char *path);
   char *as_string (); // like strdup
 
   operator bool () { return !!av; }
@@ -305,17 +342,19 @@
   SV *text; // text part
   AV *av;   // perl part
   char *line; // current beginning of line
-  char *last_value;
+  char *last_keyword, *last_value;
+  const char *name;
 
   operator bool () { return !!text; }
 
-  object_thawer (const char *filename = 0);
+  object_thawer (const char *path = 0);
   object_thawer (const char *data, AV *perlav);
   ~object_thawer ();
 
   void get (attachable *obj, int oid);
 
   keyword get_kv (); // also parse value for later use
+  void skip_kv (keyword kw);
 
   const char *get_str () { return last_value; } // may be 0
 
@@ -327,9 +366,10 @@
   sint64 get_sint64 () const;
   double get_double () const;
 
-  void get (float &v)  { v = get_double (); }
+  void get (float  &v) { v = get_double (); }
   void get (double &v) { v = get_double (); }
 
+  void get (bool   &i) { i = get_sint32 (); }
   void get (sint8  &i) { i = get_sint32 (); }
   void get (uint8  &i) { i = get_sint32 (); }
   void get (sint16 &i) { i = get_sint32 (); }
@@ -342,6 +382,28 @@
 
 char *fgets (char *s, int n, object_thawer &thawer);
 
+//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
+
+struct coroapi {
+  static struct CoroAPI *GCoroAPI;
+
+  static int nready () { return CORO_NREADY; }
+  static int cede   () { return CORO_CEDE  ; }
+
+  static int cede_counter;
+
+  static void cede_every (int count)
+  {
+    if (++cede_counter >= count)
+      {
+        cede_counter = 0;
+
+        if (coroapi::nready ())
+          coroapi::cede ();
+      }
+  }
+};
+
 struct watcher_base
 {
   static struct EventAPI *GEventAPI;