--- 8Kingdoms-1.1.0/common/TCL/tcl_script.cpp	2007-07-22 03:32:50.000000000 +0200

+++ 8Kingdoms-1.1.0.new/common/TCL/tcl_script.cpp	2008-01-08 14:33:59.000000000 +0100

@@ -12,34 +12,96 @@

 #include "common/TCL/tcl_struct.h"

 #include "world/useful.h"

 #include "world/typedefs.h"

+#include "world/rules.h"

 using namespace std;

+/* We can get called from multiple threads, protected against reentrance

+   through locks. But locks are not enough. Tcl is thread aware and does not

+   allow an interpreter to be called from another thread then it is created.

+   With Tcl-8.4 things work even when violating this Tcl thread model rule, but

+   thats pure luck on our side.

+   

+   However with Tcl-8.5 calling an interpreter from another thread then it is

+   created really no longer works. Under pthread using OS we solve this by

+   using a per thread variable for the interpreter and creating an interpreter

+   for each thread. Under non pthread OS we keep relying on our luck, so

+   Tcl-8.5 may not be used there! */

+

+#ifdef __unix__

+/* interpreter destructor for the per thread interpreter */

+static void interpreter_destructor(void *_interpreter)

+{

+    Tcl_DeleteInterp((Tcl_Interp *)_interpreter);

+}

+#endif

+

 TTCL_Interpreter::TTCL_Interpreter()

 {

-    _interpreter =  Tcl_CreateInterp();

+#ifdef __unix__

+    pthread_key_create(&_interpreter_key, interpreter_destructor);

+    _rules = NULL; 

+#else

+    _interpreter = Tcl_CreateInterp();

+#endif

 }

 TTCL_Interpreter::~TTCL_Interpreter()

 {

+#ifdef __unix__

+    pthread_key_delete(_interpreter_key);

+#else

     Tcl_DeleteInterp(_interpreter);

     //KMemFree(_interpreter);

+#endif

+}

+

+Tcl_Interp *TTCL_Interpreter::getInterpreter()

+{

+#ifdef __unix__

+    Tcl_Interp *_interpreter =

+        (Tcl_Interp *)pthread_getspecific(_interpreter_key);

+    

+    if (!_interpreter)

+    {

+        _interpreter = Tcl_CreateInterp();

+        pthread_setspecific(_interpreter_key, _interpreter);

+        

+        if (_rules)

+        {

+            _rules->writeToTCL(*this);

+            Tcl_CreateCommand(_interpreter, "KSendMessage", _TCLSendMessageProc,

+                              NULL, NULL);

+            TTCL_Script script(this);

+            script.loadStruct(_init_script);

+            script.run();

+        }

+    }

+#endif

+    return _interpreter;

 }

-void TTCL_Interpreter::init(TCL_SCRIPT * init_script)

+void TTCL_Interpreter::init(World::TRules * rules,

+    Tcl_CmdProc * TCLSendMessageProc, TCL_SCRIPT * init_script)

 {

+#ifdef __unix__

+    _rules = rules;

+    _TCLSendMessageProc = TCLSendMessageProc;

+    _init_script = init_script;

+#else

+    rules->writeToTCL(*this);

+    Tcl_CreateCommand(getInterpreter(), "KSendMessage", TCLSendMessageProc,

+                      NULL, NULL);

     TTCL_Script script(this);

     script.loadStruct(init_script);

     script.run();

+#endif

 }

 bool TTCL_Interpreter::setVar(const char * name, const TCL_VAR_TYPE type, void * value)

 {

-    if (_interpreter == NULL)

-        THROW(E_8K_TCL_Error, "TCL interpreter has not been initialized properly");

-

     // odstraneni predchoziho vyskytu promenne

-    Tcl_UnsetVar(_interpreter, name, 0);

+    Tcl_UnsetVar(getInterpreter(), name, 0);

     // nastaveni nove hodnoty

     bool result;

@@ -48,7 +110,7 @@

     switch (type) {

         case TVT_STRING:

         // STRING

-            result = (Tcl_SetVar(_interpreter, name, (const char *)value, 0) != NULL);

+            result = (Tcl_SetVar(getInterpreter(), name, (const char *)value, 0) != NULL);

             break;

         case TVT_INT:

         // INT

@@ -56,7 +118,7 @@

             snprintf(s, 255, "%d", *(int *)value);

             // ulozim cislo do TCL

-            result = (Tcl_SetVar(_interpreter, name, s, 0) != NULL);

+            result = (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);

             break;

         case TVT_FLOAT:

         // FLOAT

@@ -64,7 +126,7 @@

             snprintf(s, 255, "%f", *(float *)value);

             // ulozim cislo do TCL

-            result = (Tcl_SetVar(_interpreter, name, s, 0) != NULL);

+            result = (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);

             break;

         case TVT_FLOAT_LIST:

             {

@@ -153,11 +215,8 @@

 bool TTCL_Interpreter::getVar(const char * name, const TCL_VAR_TYPE type, void * value)

 {

-    if (_interpreter == NULL)

-        THROW(E_8K_TCL_Error, "TCL interpreter has not been initialized properly");

-

     // nacteni objektu z TCL

-    Tcl_Obj * tcl_obj = Tcl_GetVar2Ex(_interpreter, name, NULL, TCL_LEAVE_ERR_MSG);

+    Tcl_Obj * tcl_obj = Tcl_GetVar2Ex(getInterpreter(), name, NULL, TCL_LEAVE_ERR_MSG);

     // promennou se nepodarilo nacist (a pritom to nebylo asociativni pole)

     if ((tcl_obj == NULL) && (type != TVT_INT_ARRAY) && (type != TVT_FLOAT_ARRAY) && (type != TVT_STRING_ARRAY)) {        

@@ -173,14 +232,14 @@

                 return true;

             break;

         case TVT_INT:

-            if (Tcl_GetIntFromObj(_interpreter, tcl_obj, (int *)value) == TCL_OK)

+            if (Tcl_GetIntFromObj(getInterpreter(), tcl_obj, (int *)value) == TCL_OK)

                 return true;

             else

                 return false;

             break;

         case TVT_FLOAT:

             double _value;

-            if (Tcl_GetDoubleFromObj(_interpreter, tcl_obj, &_value) == TCL_OK) {

+            if (Tcl_GetDoubleFromObj(getInterpreter(), tcl_obj, &_value) == TCL_OK) {

                 // pretypovani na float

                 *(float *)value = (float)_value;

                 return true;

@@ -415,7 +474,7 @@

     char s[MAX_STRLEN];

     snprintf(s, MAX_STRLEN, "%d", value);

-    return (Tcl_SetVar(_interpreter, name, s, 0) != NULL);

+    return (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);

 }

 bool TTCL_Interpreter::setConstDouble(const char * name, const double value)

@@ -423,29 +482,21 @@

     char s[MAX_STRLEN];

     snprintf(s, MAX_STRLEN, "%.2f", value);

-    return (Tcl_SetVar(_interpreter, name, s, 0) != NULL);

+    return (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);

 }

 int TTCL_Interpreter::eval(const char * code)

 {

-    if (_interpreter == NULL)

-        THROW(E_8K_TCL_Error, "TCL interpreter has not been initialized properly");

-

-    int result =  Tcl_Eval(_interpreter, code);

+    int result =  Tcl_Eval(getInterpreter(), code);

     if (result == TCL_ERROR) {

-        THROW(E_8K_TCL_Error, Tcl_GetStringResult(_interpreter));

+        THROW(E_8K_TCL_Error, Tcl_GetStringResult(getInterpreter()));

     }

     return result;

 }

 const char * TTCL_Interpreter::getError()

 {

-    return Tcl_GetStringResult(_interpreter);

-}

-

-Tcl_Command TTCL_Interpreter::createCommand(const char * tclName, Tcl_CmdProc * cName, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)

-{

-    return Tcl_CreateCommand(_interpreter, tclName, cName, clientData, deleteProc);

+    return Tcl_GetStringResult(getInterpreter());

 }

 void TTCL_Interpreter::setResult(TCL_VAR_TYPE type, void * value)

@@ -455,21 +506,21 @@

     switch (type) {

         case TVT_STRING:

         // STRING

-            Tcl_SetResult(_interpreter, (char *)value, NULL);

+            Tcl_SetResult(getInterpreter(), (char *)value, NULL);

             break;

         case TVT_INT:

         // INT

             // prevedu cislo na string        

             snprintf(s, MAX_STRLEN, "%d", *(int *)value);

-            Tcl_SetResult(_interpreter, s, NULL);

+            Tcl_SetResult(getInterpreter(), s, NULL);

             break;

         case TVT_FLOAT:

         // FLOAT

             // prevedu cislo na string

             snprintf(s, MAX_STRLEN, "%f", *(float *)value);

-            Tcl_SetResult(_interpreter, s, NULL);

+            Tcl_SetResult(getInterpreter(), s, NULL);

             break;

         default:

             THROW(E_8K_TCL_UnknownType, "");

--- 8Kingdoms-1.1.0/common/TCL/tcl_script.h	2007-07-22 03:32:50.000000000 +0200

+++ 8Kingdoms-1.1.0.new/common/TCL/tcl_script.h	2008-01-08 14:30:55.000000000 +0100

@@ -9,6 +9,9 @@

 #include <map>

 #include <tcl.h>

+#ifdef __unix__

+#include <pthread.h>

+#endif

 #include "common/TCL/tcl_var.h"

 /// pocet desetinnych mist, pouzitych pri konverzi cisel do TCL

@@ -172,6 +175,11 @@

     char * code;

 };

+namespace World

+{

+    class TRules;

+};

+

 /** Interpret skriptu jazyka TCL

     Objektovy "obal" puvodnich TCL struktur. 

@@ -184,16 +192,26 @@

 class TTCL_Interpreter

 {

 private:

+#ifdef __unix__

+    pthread_key_t _interpreter_key;

+    TCL_SCRIPT * _init_script;

+    Tcl_CmdProc * _TCLSendMessageProc;

+    World::TRules * _rules;

+#else

     Tcl_Interp * _interpreter;

+#endif

+    Tcl_Interp *getInterpreter();

+

 public:

     TTCL_Interpreter();

     ~TTCL_Interpreter();

-

+    

     /** Inicializace prostredi TCL interpreteru.

         Nastaveni globalnich promennych, inkluze knihoven a definice spolecnych

         funkci.

         */

-    void init(TCL_SCRIPT * init_script);

+    void init(World::TRules * rules, Tcl_CmdProc * TCLSendMessageProc,

+              TCL_SCRIPT * init_script);

     /** Ulozeni promenne do prostredi TCL interpretu 

         @param name jmeno promenne

@@ -256,15 +274,6 @@

     */

     const char * getError();

-    /** Nastaveni uzivatelske funkce.

-        Umozni asociovat volani funkce z TCL s funkci v C

-        @param  tclName     jmeno funkce v TCL, jejiz volani chceme obsluhovat sami

-        @param  cName       funkce z C, ktera bude realizovat telo funkce z TCL

-        @param  clientData  arbitrary one-word value to pass to proc and deleteProc. 

-        @param  deleteProc  procedure to call before cmdName is deleted from the interpreter; allows for command-specific cleanup. If NULL, then no procedure is called before the command is deleted.

-        */

-    Tcl_Command createCommand(const char * tclName, Tcl_CmdProc * cName, ClientData clientData = NULL, Tcl_CmdDeleteProc * deleteProc = NULL);

-    

     /// Nastaveni navratove hodnoty funkce 

     void setResult(TCL_VAR_TYPE type, void * value);

 };

--- 8Kingdoms-1.1.0/world/world_client.cpp	2008-01-08 14:39:20.000000000 +0100

+++ 8Kingdoms-1.1.0.new/world/world_client.cpp	2008-01-08 14:37:05.000000000 +0100

@@ -107,13 +107,7 @@

     world->init();

     // inicializace negine

-    engine->init(world);

-    

-    // registrace zprav z TCL

-    engine->interpreter.createCommand("KSendMessage", (Tcl_CmdProc *)World::WorldClient_SendMessage);

-

-    // inkluze knihoven pro TCL (spusteni inicializacniho skriptu)

-    engine->interpreter.init(world->rules->scripts[TS_INIT]);

+    engine->init(world, (Tcl_CmdProc *)World::WorldClient_SendMessage);

   }

   // svet je pripraven

--- 8Kingdoms-1.1.0/world/world_engine.cpp	2008-01-08 14:39:21.000000000 +0100

+++ 8Kingdoms-1.1.0.new/world/world_engine.cpp	2008-01-08 14:38:37.000000000 +0100

@@ -30,11 +29,10 @@

 }

-void TWorldEngine::init(TWorld * world)

+void TWorldEngine::init(TWorld * world, Tcl_CmdProc *TCLSendMessageProc)

 {

-  // zapis pravidel do prostredi TCL interpreteru

-  if (world->rules)

-    world->rules->writeToTCL(interpreter);

+  interpreter.init(world->rules, TCLSendMessageProc,

+                   world->rules->scripts[TS_INIT]);

 }

 int TWorldEngine::lock()

--- 8Kingdoms-1.1.0/world/world_engine.h	2007-07-22 03:33:12.000000000 +0200

+++ 8Kingdoms-1.1.0.new/world/world_engine.h	2008-01-08 13:44:32.000000000 +0100

@@ -45,7 +45,7 @@

         ~TWorldEngine();

         /** Inicializace */

-        void init(TWorld * world);

+        void init(TWorld * world, Tcl_CmdProc *TCLSendMessageProc);

         /// Zamceni mutexu

         int lock();

--- 8Kingdoms-1.1.0/world/world_server.cpp	2008-01-08 14:39:20.000000000 +0100

+++ 8Kingdoms-1.1.0.new/world/world_server.cpp	2008-01-08 14:36:44.000000000 +0100

@@ -87,13 +87,7 @@

   world.init();

   // inicializace world_engine

-  engine.init(&world);

-

-  // registrace zprav z TCL

-  engine.interpreter.createCommand("KSendMessage", (Tcl_CmdProc *)WorldServer_SendMessage);

-

-  // inkluze knihoven pro TCL (spusteni inicializacniho skriptu)

-  engine.interpreter.init(world.rules->scripts[TS_INIT]);

+  engine.init(&world, (Tcl_CmdProc *)WorldServer_SendMessage);

 }

 void TWorldServer::shutdown()

--- 8Kingdoms-1.1.0/8Kingdoms.cpp~	2008-01-08 20:31:01.000000000 +0100

+++ 8Kingdoms-1.1.0/8Kingdoms.cpp	2008-01-08 20:31:01.000000000 +0100

@@ -25,6 +25,7 @@

 //rozhrani

 #include <sstream>

+#include <tcl.h>

 #include "common/Interface.h"

 #include "common/Msg.h"

@@ -470,6 +471,8 @@ void print_help(){

 */

 int main(int argc, char** argv){

+  Tcl_FindExecutable(argv[0]);

+  

   try{

     //parametry z prikazoveho radku

     TCommandLine::parseCommandLine(argc, argv);