diff options
Diffstat (limited to 'generic/tclThreadTest.c')
-rw-r--r-- | generic/tclThreadTest.c | 352 |
1 files changed, 254 insertions, 98 deletions
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index f899779..9c66313 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -7,15 +7,17 @@ * Conservation Through Innovation, Limited, with their permission. * * Copyright (c) 1998 by Sun Microsystems, Inc. + * Copyright (c) 2006-2008 by Joe Mistachkin. All rights reserved. * * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ +#ifndef USE_TCL_STUBS +# define USE_TCL_STUBS +#endif #include "tclInt.h" -extern int Tcltest_Init(Tcl_Interp *interp); - #ifdef TCL_THREADS /* * Each thread has an single instance of the following structure. There is one @@ -29,11 +31,13 @@ extern int Tcltest_Init(Tcl_Interp *interp); */ typedef struct ThreadSpecificData { - Tcl_ThreadId threadId; /* Tcl ID for this thread */ - Tcl_Interp *interp; /* Main interpreter for this thread */ - int flags; /* See the TP_ defines below... */ - struct ThreadSpecificData *nextPtr; /* List for "thread names" */ - struct ThreadSpecificData *prevPtr; /* List for "thread names" */ + Tcl_ThreadId threadId; /* Tcl ID for this thread */ + Tcl_Interp *interp; /* Main interpreter for this thread */ + int flags; /* See the TP_ defines below... */ + struct ThreadSpecificData *nextPtr; + /* List for "thread names" */ + struct ThreadSpecificData *prevPtr; + /* List for "thread names" */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; @@ -42,22 +46,23 @@ static Tcl_ThreadDataKey dataKey; * protected by threadMutex. */ -static struct ThreadSpecificData *threadList; +static ThreadSpecificData *threadList = NULL; /* * The following bit-values are legal for the "flags" field of the * ThreadSpecificData structure. */ -#define TP_Dying 0x001 /* This thread is being cancelled */ + +#define TP_Dying 0x001 /* This thread is being canceled */ /* * An instance of the following structure contains all information that is * passed into a new thread when the thread is created using either the - * "thread create" Tcl command or the TclCreateThread() C function. + * "thread create" Tcl command or the ThreadCreate() C function. */ typedef struct ThreadCtrl { - const char *script; /* The Tcl command this thread should + const char *script; /* The Tcl command this thread should * execute */ int flags; /* Initial value of the "flags" field in the * ThreadSpecificData structure for the new @@ -103,6 +108,7 @@ static ThreadEventResult *resultList; * This is for simple error handling when a thread script exits badly. */ +static Tcl_ThreadId mainThreadId; static Tcl_ThreadId errorThreadId; static char *errorProcString; @@ -113,23 +119,18 @@ static char *errorProcString; TCL_DECLARE_MUTEX(threadMutex) -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLEXPORT - -EXTERN int TclThread_Init(Tcl_Interp *interp); -EXTERN int Tcl_ThreadObjCmd(ClientData clientData, +static int ThreadObjCmd(ClientData clientData, Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]); -EXTERN int TclCreateThread(Tcl_Interp *interp, const char *script, +static int ThreadCreate(Tcl_Interp *interp, const char *script, int joinable); -EXTERN int TclThreadList(Tcl_Interp *interp); -EXTERN int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, +static int ThreadList(Tcl_Interp *interp); +static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, const char *script, int wait); +static int ThreadCancel(Tcl_Interp *interp, Tcl_ThreadId id, + const char *result, int flags); -#undef TCL_STORAGE_CLASS -#define TCL_STORAGE_CLASS DLLIMPORT - -Tcl_ThreadCreateType NewTestThread(ClientData clientData); +static Tcl_ThreadCreateType NewTestThread(ClientData clientData); static void ListRemove(ThreadSpecificData *tsdPtr); static void ListUpdateInner(ThreadSpecificData *tsdPtr); static int ThreadEventProc(Tcl_Event *evPtr, int mask); @@ -138,6 +139,7 @@ static void ThreadFreeProc(ClientData clientData); static int ThreadDeleteEvent(Tcl_Event *eventPtr, ClientData clientData); static void ThreadExitProc(ClientData clientData); +extern int Tcltest_Init(Tcl_Interp *interp); /* *---------------------------------------------------------------------- @@ -147,7 +149,7 @@ static void ThreadExitProc(ClientData clientData); * Initialize the test thread command. * * Results: - * TCL_OK if the package was properly initialized. + * TCL_OK if the package was properly initialized. * * Side effects: * Add the "testthread" command to the interp. @@ -159,9 +161,17 @@ int TclThread_Init( Tcl_Interp *interp) /* The current Tcl interpreter */ { + /* + * If the main thread Id has not been set, do it now. + */ - Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd, - (ClientData) NULL, NULL); + Tcl_MutexLock(&threadMutex); + if (mainThreadId == 0) { + mainThreadId = Tcl_GetCurrentThread(); + } + Tcl_MutexUnlock(&threadMutex); + + Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL); return TCL_OK; } @@ -169,15 +179,17 @@ TclThread_Init( /* *---------------------------------------------------------------------- * - * Tcl_ThreadObjCmd -- + * ThreadObjCmd -- * * This procedure is invoked to process the "testthread" Tcl command. See * the user documentation for details on what it does. * + * thread cancel ?-unwind? id ?result? * thread create ?-joinable? ?script? - * thread send id ?-async? script + * thread send ?-async? id script + * thread event * thread exit - * thread info id + * thread id ?-main? * thread names * thread wait * thread errorproc proc @@ -193,8 +205,8 @@ TclThread_Init( */ /* ARGSUSED */ -int -Tcl_ThreadObjCmd( +static int +ThreadObjCmd( ClientData dummy, /* Not used. */ Tcl_Interp *interp, /* Current interpreter. */ int objc, /* Number of arguments. */ @@ -202,17 +214,19 @@ Tcl_ThreadObjCmd( { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int option; - static const char *threadOptions[] = { - "create", "exit", "id", "join", "names", - "send", "wait", "errorproc", NULL + static const char *const threadOptions[] = { + "cancel", "create", "event", "exit", "id", + "join", "names", "send", "wait", "errorproc", + NULL }; enum options { - THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES, - THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC + THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT, + THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND, + THREAD_WAIT, THREAD_ERRORPROC }; if (objc < 2) { - Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); + Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?"); return TCL_ERROR; } if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0, @@ -233,6 +247,34 @@ Tcl_ThreadObjCmd( } switch ((enum options)option) { + case THREAD_CANCEL: { + long id; + const char *result; + int flags, arg; + + if ((objc < 3) || (objc > 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "?-unwind? id ?result?"); + return TCL_ERROR; + } + flags = 0; + arg = 2; + if ((objc == 4) || (objc == 5)) { + if (strcmp("-unwind", Tcl_GetString(objv[arg])) == 0) { + flags = TCL_CANCEL_UNWIND; + arg++; + } + } + if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + return TCL_ERROR; + } + arg++; + if (arg < objc) { + result = Tcl_GetString(objv[arg]); + } else { + result = NULL; + } + return ThreadCancel(interp, (Tcl_ThreadId) (size_t) id, result, flags); + } case THREAD_CREATE: { const char *script; int joinable, len; @@ -252,9 +294,8 @@ Tcl_ThreadObjCmd( script = Tcl_GetStringFromObj(objv[2], &len); - if ((len > 1) && - (script [0] == '-') && (script [1] == 'j') && - (0 == strncmp (script, "-joinable", (size_t) len))) { + if ((len > 1) && (script[0] == '-') && (script[1] == 'j') && + (0 == strncmp(script, "-joinable", (size_t) len))) { joinable = 1; script = "testthread wait"; /* Just enter event loop */ } else { @@ -270,17 +311,14 @@ Tcl_ThreadObjCmd( */ script = Tcl_GetStringFromObj(objv[2], &len); - - joinable = ((len > 1) && - (script [0] == '-') && (script [1] == 'j') && - (0 == strncmp(script, "-joinable", (size_t) len))); - + joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j') + && (0 == strncmp(script, "-joinable", (size_t) len))); script = Tcl_GetString(objv[3]); } else { Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); return TCL_ERROR; } - return TclCreateThread(interp, script, joinable); + return ThreadCreate(interp, script, joinable); } case THREAD_EXIT: if (objc > 2) { @@ -291,8 +329,24 @@ Tcl_ThreadObjCmd( Tcl_ExitThread(0); return TCL_OK; case THREAD_ID: - if (objc == 2) { - Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t) Tcl_GetCurrentThread()); + if (objc == 2 || objc == 3) { + Tcl_Obj *idObj; + + /* + * Check if they want the main thread id or the current thread id. + */ + + if (objc == 2) { + idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); + } else if (objc == 3 + && strcmp("-main", Tcl_GetString(objv[2])) == 0) { + Tcl_MutexLock(&threadMutex); + idObj = Tcl_NewLongObj((long)(size_t)mainThreadId); + Tcl_MutexUnlock(&threadMutex); + } else { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } Tcl_SetObjResult(interp, idObj); return TCL_OK; @@ -312,11 +366,11 @@ Tcl_ThreadObjCmd( return TCL_ERROR; } - result = Tcl_JoinThread ((Tcl_ThreadId)(size_t)id, &status); + result = Tcl_JoinThread((Tcl_ThreadId)(size_t)id, &status); if (result == TCL_OK) { - Tcl_SetIntObj (Tcl_GetObjResult (interp), status); + Tcl_SetIntObj(Tcl_GetObjResult(interp), status); } else { - char buf [20]; + char buf[20]; sprintf(buf, "%" TCL_LL_MODIFIER "d", id); Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); @@ -328,7 +382,7 @@ Tcl_ThreadObjCmd( Tcl_WrongNumArgs(interp, 2, objv, NULL); return TCL_ERROR; } - return TclThreadList(interp); + return ThreadList(interp); case THREAD_SEND: { Tcl_WideInt id; const char *script; @@ -354,14 +408,23 @@ Tcl_ThreadObjCmd( } arg++; script = Tcl_GetString(objv[arg]); - return TclThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait); + return ThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait); + } + case THREAD_EVENT: { + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } + Tcl_SetObjResult(interp, Tcl_NewIntObj( + Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT))); + return TCL_OK; } case THREAD_ERRORPROC: { /* * Arrange for this proc to handle thread death errors. */ - char *proc; + const char *proc; if (objc != 3) { Tcl_WrongNumArgs(interp, 2, objv, "proc"); @@ -373,15 +436,41 @@ Tcl_ThreadObjCmd( ckfree(errorProcString); } proc = Tcl_GetString(objv[2]); - errorProcString = ckalloc(strlen(proc)+1); + errorProcString = ckalloc(strlen(proc) + 1); strcpy(errorProcString, proc); Tcl_MutexUnlock(&threadMutex); return TCL_OK; } case THREAD_WAIT: + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, ""); + return TCL_ERROR; + } while (1) { + /* + * If the script has been unwound, bail out immediately. This does + * not follow the recommended guidelines for how extensions should + * handle the script cancellation functionality because this is + * not a "normal" extension. Most extensions do not have a command + * that simply enters an infinite Tcl event loop. Normal + * extensions should not specify the TCL_CANCEL_UNWIND when + * calling Tcl_Canceled to check if the command has been canceled. + */ + + if (Tcl_Canceled(interp, + TCL_LEAVE_ERR_MSG | TCL_CANCEL_UNWIND) == TCL_ERROR) { + break; + } (void) Tcl_DoOneEvent(TCL_ALL_EVENTS); } + + /* + * If we get to this point, we have been canceled by another thread, + * which is considered to be an "error". + */ + + ThreadErrorProc(interp); + return TCL_OK; } return TCL_OK; } @@ -389,7 +478,7 @@ Tcl_ThreadObjCmd( /* *---------------------------------------------------------------------- * - * TclCreateThread -- + * ThreadCreate -- * * This procedure is invoked to create a thread containing an interp to * run a script. This returns after the thread has started executing. @@ -404,8 +493,8 @@ Tcl_ThreadObjCmd( */ /* ARGSUSED */ -int -TclCreateThread( +static int +ThreadCreate( Tcl_Interp *interp, /* Current interpreter. */ const char *script, /* Script to execute */ int joinable) /* Flag, joinable thread or not */ @@ -423,7 +512,7 @@ TclCreateThread( if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl, TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) { Tcl_MutexUnlock(&threadMutex); - Tcl_AppendResult(interp, "can't create a new thread", NULL); + Tcl_AppendResult(interp, "can't create a new thread", NULL); return TCL_ERROR; } @@ -470,18 +559,20 @@ Tcl_ThreadCreateType NewTestThread( ClientData clientData) { - ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData; + ThreadCtrl *ctrlPtr = clientData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int result; char *threadEvalScript; /* - * Initialize the interpreter. This should be more general. + * Initialize the interpreter. This should be more general. */ tsdPtr->interp = Tcl_CreateInterp(); result = Tcl_Init(tsdPtr->interp); - result = TclThread_Init(tsdPtr->interp); + if (result != TCL_OK) { + ThreadErrorProc(tsdPtr->interp); + } /* * This is part of the test facility. Initialize _ALL_ test commands for @@ -489,6 +580,9 @@ NewTestThread( */ result = Tcltest_Init(tsdPtr->interp); + if (result != TCL_OK) { + ThreadErrorProc(tsdPtr->interp); + } /* * Update the list of threads. @@ -502,10 +596,10 @@ NewTestThread( * eval'ing, for the case that we exit during evaluation */ - threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1); + threadEvalScript = ckalloc(strlen(ctrlPtr->script) + 1); strcpy(threadEvalScript, ctrlPtr->script); - Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript); + Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript); /* * Notify the parent we are alive. @@ -518,8 +612,8 @@ NewTestThread( * Run the script. */ - Tcl_Preserve((ClientData) tsdPtr->interp); - result = Tcl_Eval(tsdPtr->interp, threadEvalScript); + Tcl_Preserve(tsdPtr->interp); + result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, -1, 0); if (result != TCL_OK) { ThreadErrorProc(tsdPtr->interp); } @@ -528,9 +622,9 @@ NewTestThread( * Clean up. */ - ListRemove(tsdPtr); - Tcl_Release((ClientData) tsdPtr->interp); Tcl_DeleteInterp(tsdPtr->interp); + Tcl_Release(tsdPtr->interp); + ListRemove(tsdPtr); Tcl_ExitThread(result); TCL_THREAD_CREATE_RETURN; @@ -560,6 +654,7 @@ ThreadErrorProc( const char *errorInfo, *argv[3]; char *script; char buf[TCL_DOUBLE_SPACE+1]; + sprintf(buf, "%" TCL_LL_MODIFIER "d", (Tcl_WideInt)(size_t)Tcl_GetCurrentThread()); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); @@ -575,7 +670,7 @@ ThreadErrorProc( argv[1] = buf; argv[2] = errorInfo; script = Tcl_Merge(3, argv); - TclThreadSend(interp, errorThreadId, script, 0); + ThreadSend(interp, errorThreadId, script, 0); ckfree(script); } } @@ -648,13 +743,14 @@ ListRemove( tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr; } tsdPtr->nextPtr = tsdPtr->prevPtr = 0; + tsdPtr->interp = NULL; Tcl_MutexUnlock(&threadMutex); } /* *------------------------------------------------------------------------ * - * TclThreadList -- + * ThreadList -- * * Return a list of threads running Tcl interpreters. * @@ -666,8 +762,8 @@ ListRemove( * *------------------------------------------------------------------------ */ -int -TclThreadList( +static int +ThreadList( Tcl_Interp *interp) { ThreadSpecificData *tsdPtr; @@ -687,7 +783,7 @@ TclThreadList( /* *------------------------------------------------------------------------ * - * TclThreadSend -- + * ThreadSend -- * * Send a script to another thread. * @@ -700,8 +796,8 @@ TclThreadList( *------------------------------------------------------------------------ */ -int -TclThreadSend( +static int +ThreadSend( Tcl_Interp *interp, /* The current interpreter. */ Tcl_ThreadId id, /* Thread Id of other interpreter. */ const char *script, /* The script to evaluate. */ @@ -737,21 +833,21 @@ TclThreadSend( */ if (threadId == Tcl_GetCurrentThread()) { - Tcl_MutexUnlock(&threadMutex); - return Tcl_GlobalEval(interp, script); + Tcl_MutexUnlock(&threadMutex); + return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL); } /* * Create the event for its event queue. */ - threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent)); + threadEventPtr = ckalloc(sizeof(ThreadEvent)); threadEventPtr->script = ckalloc(strlen(script) + 1); strcpy(threadEventPtr->script, script); if (!wait) { resultPtr = threadEventPtr->resultPtr = NULL; } else { - resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult)); + resultPtr = ckalloc(sizeof(ThreadEventResult)); threadEventPtr->resultPtr = resultPtr; /* @@ -784,7 +880,7 @@ TclThreadSend( */ threadEventPtr->event.proc = ThreadEventProc; - Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, + Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(threadId); @@ -799,7 +895,7 @@ TclThreadSend( Tcl_ResetResult(interp); while (resultPtr->result == NULL) { - Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL); + Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL); } /* @@ -830,11 +926,12 @@ TclThreadSend( ckfree(resultPtr->errorInfo); } } - Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC); + Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; - ckfree((char *) resultPtr); + ckfree(resultPtr->result); + ckfree(resultPtr); return code; } @@ -842,6 +939,62 @@ TclThreadSend( /* *------------------------------------------------------------------------ * + * ThreadCancel -- + * + * Cancels a script in another thread. + * + * Results: + * A standard Tcl result. + * + * Side effects: + * None. + * + *------------------------------------------------------------------------ + */ + +static int +ThreadCancel( + Tcl_Interp *interp, /* The current interpreter. */ + Tcl_ThreadId id, /* Thread Id of other interpreter. */ + const char *result, /* The result or NULL for default. */ + int flags) /* Flags for Tcl_CancelEval. */ +{ + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + int found; + Tcl_ThreadId threadId = (Tcl_ThreadId) id; + + /* + * Verify the thread exists. + */ + + Tcl_MutexLock(&threadMutex); + found = 0; + for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { + if (tsdPtr->threadId == threadId) { + found = 1; + break; + } + } + if (!found) { + Tcl_MutexUnlock(&threadMutex); + Tcl_AppendResult(interp, "invalid thread id", NULL); + return TCL_ERROR; + } + + /* + * Since Tcl_CancelEval can be safely called from any thread, + * we do it now. + */ + + Tcl_MutexUnlock(&threadMutex); + Tcl_ResetResult(interp); + return Tcl_CancelEval(tsdPtr->interp, + (result != NULL) ? Tcl_NewStringObj(result, -1) : NULL, 0, flags); +} + +/* + *------------------------------------------------------------------------ + * * ThreadEventProc -- * * Handle the event in the target thread. @@ -861,7 +1014,7 @@ ThreadEventProc( int mask) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); - ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr; + ThreadEvent *threadEventPtr = (ThreadEvent *) evPtr; ThreadEventResult *resultPtr = threadEventPtr->resultPtr; Tcl_Interp *interp = tsdPtr->interp; int code; @@ -873,13 +1026,11 @@ ThreadEventProc( errorCode = "THREAD"; errorInfo = ""; } else { - Tcl_Preserve((ClientData) interp); + Tcl_Preserve(interp); Tcl_ResetResult(interp); - Tcl_CreateThreadExitHandler(ThreadFreeProc, - (ClientData) threadEventPtr->script); - code = Tcl_GlobalEval(interp, threadEventPtr->script); - Tcl_DeleteThreadExitHandler(ThreadFreeProc, - (ClientData) threadEventPtr->script); + Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script); + code = Tcl_EvalEx(interp, threadEventPtr->script,-1,TCL_EVAL_GLOBAL); + Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script); if (code != TCL_OK) { errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); @@ -906,7 +1057,7 @@ ThreadEventProc( Tcl_MutexUnlock(&threadMutex); } if (interp != NULL) { - Tcl_Release((ClientData) interp); + Tcl_Release(interp); } return 1; } @@ -934,7 +1085,7 @@ ThreadFreeProc( ClientData clientData) { if (clientData) { - ckfree((char *) clientData); + ckfree(clientData); } } @@ -962,7 +1113,7 @@ ThreadDeleteEvent( ClientData clientData) /* dummy */ { if (eventPtr->proc == ThreadEventProc) { - ckfree((char *) ((ThreadEvent *) eventPtr)->script); + ckfree(((ThreadEvent *) eventPtr)->script); return 1; } @@ -996,17 +1147,22 @@ static void ThreadExitProc( ClientData clientData) { - char *threadEvalScript = (char *) clientData; + char *threadEvalScript = clientData; ThreadEventResult *resultPtr, *nextPtr; Tcl_ThreadId self = Tcl_GetCurrentThread(); + ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); + + if (tsdPtr->interp != NULL) { + ListRemove(tsdPtr); + } Tcl_MutexLock(&threadMutex); if (threadEvalScript) { - ckfree((char *) threadEvalScript); + ckfree(threadEvalScript); threadEvalScript = NULL; } - Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL); + Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL); for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) { nextPtr = resultPtr->nextPtr; @@ -1026,7 +1182,7 @@ ThreadExitProc( } resultPtr->nextPtr = resultPtr->prevPtr = 0; resultPtr->eventPtr->resultPtr = NULL; - ckfree((char *) resultPtr); + ckfree(resultPtr); } else if (resultPtr->dstThreadId == self) { /* * Dang. The target is going away. Unblock the caller. The result @@ -1036,7 +1192,7 @@ ThreadExitProc( const char *msg = "target thread died"; - resultPtr->result = ckalloc(strlen(msg)+1); + resultPtr->result = ckalloc(strlen(msg) + 1); strcpy(resultPtr->result, msg); resultPtr->code = TCL_ERROR; Tcl_ConditionNotify(&resultPtr->done); |