/[pkgs]/devel/8Kingdoms/8Kingdoms-1.1.0-tcl-threads.patch
ViewVC logotype

Contents of /devel/8Kingdoms/8Kingdoms-1.1.0-tcl-threads.patch

Parent Directory Parent Directory | Revision Log Revision Log

Revision 1.1 - (show annotations) (download) (as text)
Tue Jan 8 19:40:32 2008 UTC (22 months, 2 weeks ago) by jwrdegoede
Branch: MAIN
CVS Tags: Kingdoms-1_1_0-6_fc9, Kingdoms-1_1_0-5_fc9, F-10-split, Kingdoms-1_1_0-7_fc11, F-9-split, HEAD
File MIME type: text/x-patch 
* Tue Jan  8 2008 Hans de Goede <j.w.r.degoede@hhs.nl> 1.1.0-5
- Don't call a TclInterpreter from other threads then its created in, this
  violates Tcl's thread model, this fixes running with Tcl-8.5
1 --- 8Kingdoms-1.1.0/common/TCL/tcl_script.cpp 2007-07-22 03:32:50.000000000 +0200
2 +++ 8Kingdoms-1.1.0.new/common/TCL/tcl_script.cpp 2008-01-08 14:33:59.000000000 +0100
3 @@ -12,34 +12,96 @@
4 #include "common/TCL/tcl_struct.h"
5 #include "world/useful.h"
6 #include "world/typedefs.h"
7 +#include "world/rules.h"
8
9 using namespace std;
10
11 +/* We can get called from multiple threads, protected against reentrance
12 + through locks. But locks are not enough. Tcl is thread aware and does not
13 + allow an interpreter to be called from another thread then it is created.
14 + With Tcl-8.4 things work even when violating this Tcl thread model rule, but
15 + thats pure luck on our side.
16 +
17 + However with Tcl-8.5 calling an interpreter from another thread then it is
18 + created really no longer works. Under pthread using OS we solve this by
19 + using a per thread variable for the interpreter and creating an interpreter
20 + for each thread. Under non pthread OS we keep relying on our luck, so
21 + Tcl-8.5 may not be used there! */
22 +
23 +#ifdef __unix__
24 +/* interpreter destructor for the per thread interpreter */
25 +static void interpreter_destructor(void *_interpreter)
26 +{
27 + Tcl_DeleteInterp((Tcl_Interp *)_interpreter);
28 +}
29 +#endif
30 +
31 TTCL_Interpreter::TTCL_Interpreter()
32 {
33 - _interpreter = Tcl_CreateInterp();
34 +#ifdef __unix__
35 + pthread_key_create(&_interpreter_key, interpreter_destructor);
36 + _rules = NULL;
37 +#else
38 + _interpreter = Tcl_CreateInterp();
39 +#endif
40 }
41
42 TTCL_Interpreter::~TTCL_Interpreter()
43 {
44 +#ifdef __unix__
45 + pthread_key_delete(_interpreter_key);
46 +#else
47 Tcl_DeleteInterp(_interpreter);
48 //KMemFree(_interpreter);
49 +#endif
50 +}
51 +
52 +Tcl_Interp *TTCL_Interpreter::getInterpreter()
53 +{
54 +#ifdef __unix__
55 + Tcl_Interp *_interpreter =
56 + (Tcl_Interp *)pthread_getspecific(_interpreter_key);
57 +
58 + if (!_interpreter)
59 + {
60 + _interpreter = Tcl_CreateInterp();
61 + pthread_setspecific(_interpreter_key, _interpreter);
62 +
63 + if (_rules)
64 + {
65 + _rules->writeToTCL(*this);
66 + Tcl_CreateCommand(_interpreter, "KSendMessage", _TCLSendMessageProc,
67 + NULL, NULL);
68 + TTCL_Script script(this);
69 + script.loadStruct(_init_script);
70 + script.run();
71 + }
72 + }
73 +#endif
74 + return _interpreter;
75 }
76
77 -void TTCL_Interpreter::init(TCL_SCRIPT * init_script)
78 +void TTCL_Interpreter::init(World::TRules * rules,
79 + Tcl_CmdProc * TCLSendMessageProc, TCL_SCRIPT * init_script)
80 {
81 +#ifdef __unix__
82 + _rules = rules;
83 + _TCLSendMessageProc = TCLSendMessageProc;
84 + _init_script = init_script;
85 +#else
86 + rules->writeToTCL(*this);
87 + Tcl_CreateCommand(getInterpreter(), "KSendMessage", TCLSendMessageProc,
88 + NULL, NULL);
89 TTCL_Script script(this);
90 script.loadStruct(init_script);
91 script.run();
92 +#endif
93 }
94
95 bool TTCL_Interpreter::setVar(const char * name, const TCL_VAR_TYPE type, void * value)
96 {
97 - if (_interpreter == NULL)
98 - THROW(E_8K_TCL_Error, "TCL interpreter has not been initialized properly");
99 -
100 // odstraneni predchoziho vyskytu promenne
101 - Tcl_UnsetVar(_interpreter, name, 0);
102 + Tcl_UnsetVar(getInterpreter(), name, 0);
103
104 // nastaveni nove hodnoty
105 bool result;
106 @@ -48,7 +110,7 @@
107 switch (type) {
108 case TVT_STRING:
109 // STRING
110 - result = (Tcl_SetVar(_interpreter, name, (const char *)value, 0) != NULL);
111 + result = (Tcl_SetVar(getInterpreter(), name, (const char *)value, 0) != NULL);
112 break;
113 case TVT_INT:
114 // INT
115 @@ -56,7 +118,7 @@
116 snprintf(s, 255, "%d", *(int *)value);
117
118 // ulozim cislo do TCL
119 - result = (Tcl_SetVar(_interpreter, name, s, 0) != NULL);
120 + result = (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);
121 break;
122 case TVT_FLOAT:
123 // FLOAT
124 @@ -64,7 +126,7 @@
125 snprintf(s, 255, "%f", *(float *)value);
126
127 // ulozim cislo do TCL
128 - result = (Tcl_SetVar(_interpreter, name, s, 0) != NULL);
129 + result = (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);
130 break;
131 case TVT_FLOAT_LIST:
132 {
133 @@ -153,11 +215,8 @@
134
135 bool TTCL_Interpreter::getVar(const char * name, const TCL_VAR_TYPE type, void * value)
136 {
137 - if (_interpreter == NULL)
138 - THROW(E_8K_TCL_Error, "TCL interpreter has not been initialized properly");
139 -
140 // nacteni objektu z TCL
141 - Tcl_Obj * tcl_obj = Tcl_GetVar2Ex(_interpreter, name, NULL, TCL_LEAVE_ERR_MSG);
142 + Tcl_Obj * tcl_obj = Tcl_GetVar2Ex(getInterpreter(), name, NULL, TCL_LEAVE_ERR_MSG);
143
144 // promennou se nepodarilo nacist (a pritom to nebylo asociativni pole)
145 if ((tcl_obj == NULL) && (type != TVT_INT_ARRAY) && (type != TVT_FLOAT_ARRAY) && (type != TVT_STRING_ARRAY)) {
146 @@ -173,14 +232,14 @@
147 return true;
148 break;
149 case TVT_INT:
150 - if (Tcl_GetIntFromObj(_interpreter, tcl_obj, (int *)value) == TCL_OK)
151 + if (Tcl_GetIntFromObj(getInterpreter(), tcl_obj, (int *)value) == TCL_OK)
152 return true;
153 else
154 return false;
155 break;
156 case TVT_FLOAT:
157 double _value;
158 - if (Tcl_GetDoubleFromObj(_interpreter, tcl_obj, &_value) == TCL_OK) {
159 + if (Tcl_GetDoubleFromObj(getInterpreter(), tcl_obj, &_value) == TCL_OK) {
160 // pretypovani na float
161 *(float *)value = (float)_value;
162 return true;
163 @@ -415,7 +474,7 @@
164 char s[MAX_STRLEN];
165
166 snprintf(s, MAX_STRLEN, "%d", value);
167 - return (Tcl_SetVar(_interpreter, name, s, 0) != NULL);
168 + return (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);
169 }
170
171 bool TTCL_Interpreter::setConstDouble(const char * name, const double value)
172 @@ -423,29 +482,21 @@
173 char s[MAX_STRLEN];
174
175 snprintf(s, MAX_STRLEN, "%.2f", value);
176 - return (Tcl_SetVar(_interpreter, name, s, 0) != NULL);
177 + return (Tcl_SetVar(getInterpreter(), name, s, 0) != NULL);
178 }
179
180 int TTCL_Interpreter::eval(const char * code)
181 {
182 - if (_interpreter == NULL)
183 - THROW(E_8K_TCL_Error, "TCL interpreter has not been initialized properly");
184 -
185 - int result = Tcl_Eval(_interpreter, code);
186 + int result = Tcl_Eval(getInterpreter(), code);
187 if (result == TCL_ERROR) {
188 - THROW(E_8K_TCL_Error, Tcl_GetStringResult(_interpreter));
189 + THROW(E_8K_TCL_Error, Tcl_GetStringResult(getInterpreter()));
190 }
191 return result;
192 }
193
194 const char * TTCL_Interpreter::getError()
195 {
196 - return Tcl_GetStringResult(_interpreter);
197 -}
198 -
199 -Tcl_Command TTCL_Interpreter::createCommand(const char * tclName, Tcl_CmdProc * cName, ClientData clientData, Tcl_CmdDeleteProc * deleteProc)
200 -{
201 - return Tcl_CreateCommand(_interpreter, tclName, cName, clientData, deleteProc);
202 + return Tcl_GetStringResult(getInterpreter());
203 }
204
205 void TTCL_Interpreter::setResult(TCL_VAR_TYPE type, void * value)
206 @@ -455,21 +506,21 @@
207 switch (type) {
208 case TVT_STRING:
209 // STRING
210 - Tcl_SetResult(_interpreter, (char *)value, NULL);
211 + Tcl_SetResult(getInterpreter(), (char *)value, NULL);
212 break;
213 case TVT_INT:
214 // INT
215 // prevedu cislo na string
216 snprintf(s, MAX_STRLEN, "%d", *(int *)value);
217
218 - Tcl_SetResult(_interpreter, s, NULL);
219 + Tcl_SetResult(getInterpreter(), s, NULL);
220 break;
221 case TVT_FLOAT:
222 // FLOAT
223 // prevedu cislo na string
224 snprintf(s, MAX_STRLEN, "%f", *(float *)value);
225
226 - Tcl_SetResult(_interpreter, s, NULL);
227 + Tcl_SetResult(getInterpreter(), s, NULL);
228 break;
229 default:
230 THROW(E_8K_TCL_UnknownType, "");
231 --- 8Kingdoms-1.1.0/common/TCL/tcl_script.h 2007-07-22 03:32:50.000000000 +0200
232 +++ 8Kingdoms-1.1.0.new/common/TCL/tcl_script.h 2008-01-08 14:30:55.000000000 +0100
233 @@ -9,6 +9,9 @@
234
235 #include <map>
236 #include <tcl.h>
237 +#ifdef __unix__
238 +#include <pthread.h>
239 +#endif
240 #include "common/TCL/tcl_var.h"
241
242 /// pocet desetinnych mist, pouzitych pri konverzi cisel do TCL
243 @@ -172,6 +175,11 @@
244 char * code;
245 };
246
247 +namespace World
248 +{
249 + class TRules;
250 +};
251 +
252 /** Interpret skriptu jazyka TCL
253 Objektovy "obal" puvodnich TCL struktur.
254
255 @@ -184,16 +192,26 @@
256 class TTCL_Interpreter
257 {
258 private:
259 +#ifdef __unix__
260 + pthread_key_t _interpreter_key;
261 + TCL_SCRIPT * _init_script;
262 + Tcl_CmdProc * _TCLSendMessageProc;
263 + World::TRules * _rules;
264 +#else
265 Tcl_Interp * _interpreter;
266 +#endif
267 + Tcl_Interp *getInterpreter();
268 +
269 public:
270 TTCL_Interpreter();
271 ~TTCL_Interpreter();
272 -
273 +
274 /** Inicializace prostredi TCL interpreteru.
275 Nastaveni globalnich promennych, inkluze knihoven a definice spolecnych
276 funkci.
277 */
278 - void init(TCL_SCRIPT * init_script);
279 + void init(World::TRules * rules, Tcl_CmdProc * TCLSendMessageProc,
280 + TCL_SCRIPT * init_script);
281
282 /** Ulozeni promenne do prostredi TCL interpretu
283 @param name jmeno promenne
284 @@ -256,15 +274,6 @@
285 */
286 const char * getError();
287
288 - /** Nastaveni uzivatelske funkce.
289 - Umozni asociovat volani funkce z TCL s funkci v C
290 - @param tclName jmeno funkce v TCL, jejiz volani chceme obsluhovat sami
291 - @param cName funkce z C, ktera bude realizovat telo funkce z TCL
292 - @param clientData arbitrary one-word value to pass to proc and deleteProc.
293 - @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.
294 - */
295 - Tcl_Command createCommand(const char * tclName, Tcl_CmdProc * cName, ClientData clientData = NULL, Tcl_CmdDeleteProc * deleteProc = NULL);
296 -
297 /// Nastaveni navratove hodnoty funkce
298 void setResult(TCL_VAR_TYPE type, void * value);
299 };
300 --- 8Kingdoms-1.1.0/world/world_client.cpp 2008-01-08 14:39:20.000000000 +0100
301 +++ 8Kingdoms-1.1.0.new/world/world_client.cpp 2008-01-08 14:37:05.000000000 +0100
302 @@ -107,13 +107,7 @@
303 world->init();
304
305 // inicializace negine
306 - engine->init(world);
307 -
308 - // registrace zprav z TCL
309 - engine->interpreter.createCommand("KSendMessage", (Tcl_CmdProc *)World::WorldClient_SendMessage);
310 -
311 - // inkluze knihoven pro TCL (spusteni inicializacniho skriptu)
312 - engine->interpreter.init(world->rules->scripts[TS_INIT]);
313 + engine->init(world, (Tcl_CmdProc *)World::WorldClient_SendMessage);
314 }
315
316 // svet je pripraven
317 --- 8Kingdoms-1.1.0/world/world_engine.cpp 2008-01-08 14:39:21.000000000 +0100
318 +++ 8Kingdoms-1.1.0.new/world/world_engine.cpp 2008-01-08 14:38:37.000000000 +0100
319 @@ -30,11 +29,10 @@
320
321 }
322
323 -void TWorldEngine::init(TWorld * world)
324 +void TWorldEngine::init(TWorld * world, Tcl_CmdProc *TCLSendMessageProc)
325 {
326 - // zapis pravidel do prostredi TCL interpreteru
327 - if (world->rules)
328 - world->rules->writeToTCL(interpreter);
329 + interpreter.init(world->rules, TCLSendMessageProc,
330 + world->rules->scripts[TS_INIT]);
331 }
332
333 int TWorldEngine::lock()
334 --- 8Kingdoms-1.1.0/world/world_engine.h 2007-07-22 03:33:12.000000000 +0200
335 +++ 8Kingdoms-1.1.0.new/world/world_engine.h 2008-01-08 13:44:32.000000000 +0100
336 @@ -45,7 +45,7 @@
337 ~TWorldEngine();
338
339 /** Inicializace */
340 - void init(TWorld * world);
341 + void init(TWorld * world, Tcl_CmdProc *TCLSendMessageProc);
342
343 /// Zamceni mutexu
344 int lock();
345 --- 8Kingdoms-1.1.0/world/world_server.cpp 2008-01-08 14:39:20.000000000 +0100
346 +++ 8Kingdoms-1.1.0.new/world/world_server.cpp 2008-01-08 14:36:44.000000000 +0100
347 @@ -87,13 +87,7 @@
348 world.init();
349
350 // inicializace world_engine
351 - engine.init(&world);
352 -
353 - // registrace zprav z TCL
354 - engine.interpreter.createCommand("KSendMessage", (Tcl_CmdProc *)WorldServer_SendMessage);
355 -
356 - // inkluze knihoven pro TCL (spusteni inicializacniho skriptu)
357 - engine.interpreter.init(world.rules->scripts[TS_INIT]);
358 + engine.init(&world, (Tcl_CmdProc *)WorldServer_SendMessage);
359 }
360
361 void TWorldServer::shutdown()
362 --- 8Kingdoms-1.1.0/8Kingdoms.cpp~ 2008-01-08 20:31:01.000000000 +0100
363 +++ 8Kingdoms-1.1.0/8Kingdoms.cpp 2008-01-08 20:31:01.000000000 +0100
364 @@ -25,6 +25,7 @@
365
366 //rozhrani
367 #include <sstream>
368 +#include <tcl.h>
369
370 #include "common/Interface.h"
371 #include "common/Msg.h"
372 @@ -470,6 +471,8 @@ void print_help(){
373 */
374 int main(int argc, char** argv){
375
376 + Tcl_FindExecutable(argv[0]);
377 +
378 try{
379 //parametry z prikazoveho radku
380 TCommandLine::parseCommandLine(argc, argv);
admin@fedoraproject.org
 ViewVC Help
Powered by ViewVC 1.1.2