--- 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 #include +#ifdef __unix__ +#include +#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 +#include #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);