summaryrefslogtreecommitdiffstats
path: root/generic/tclThreadTest.c
diff options
context:
space:
mode:
Diffstat (limited to 'generic/tclThreadTest.c')
-rw-r--r--generic/tclThreadTest.c346
1 files changed, 95 insertions, 251 deletions
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c
index 02ee038..f899779 100644
--- a/generic/tclThreadTest.c
+++ b/generic/tclThreadTest.c
@@ -7,17 +7,15 @@
* 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
@@ -31,13 +29,11 @@
*/
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;
@@ -46,23 +42,22 @@ static Tcl_ThreadDataKey dataKey;
* protected by threadMutex.
*/
-static ThreadSpecificData *threadList = NULL;
+static struct ThreadSpecificData *threadList;
/*
* The following bit-values are legal for the "flags" field of the
* ThreadSpecificData structure.
*/
-
-#define TP_Dying 0x001 /* This thread is being canceled */
+#define TP_Dying 0x001 /* This thread is being cancelled */
/*
* 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 ThreadCreate() C function.
+ * "thread create" Tcl command or the TclCreateThread() 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
@@ -108,7 +103,6 @@ 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;
@@ -119,18 +113,23 @@ static char *errorProcString;
TCL_DECLARE_MUTEX(threadMutex)
-static int ThreadObjCmd(ClientData clientData,
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLEXPORT
+
+EXTERN int TclThread_Init(Tcl_Interp *interp);
+EXTERN int Tcl_ThreadObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc,
Tcl_Obj *const objv[]);
-static int ThreadCreate(Tcl_Interp *interp, const char *script,
+EXTERN int TclCreateThread(Tcl_Interp *interp, const char *script,
int joinable);
-static int ThreadList(Tcl_Interp *interp);
-static int ThreadSend(Tcl_Interp *interp, Tcl_ThreadId id,
+EXTERN int TclThreadList(Tcl_Interp *interp);
+EXTERN int TclThreadSend(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);
-static Tcl_ThreadCreateType NewTestThread(ClientData clientData);
+#undef TCL_STORAGE_CLASS
+#define TCL_STORAGE_CLASS DLLIMPORT
+
+Tcl_ThreadCreateType NewTestThread(ClientData clientData);
static void ListRemove(ThreadSpecificData *tsdPtr);
static void ListUpdateInner(ThreadSpecificData *tsdPtr);
static int ThreadEventProc(Tcl_Event *evPtr, int mask);
@@ -139,7 +138,6 @@ 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);
/*
*----------------------------------------------------------------------
@@ -149,7 +147,7 @@ extern int Tcltest_Init(Tcl_Interp *interp);
* 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.
@@ -161,17 +159,9 @@ int
TclThread_Init(
Tcl_Interp *interp) /* The current Tcl interpreter */
{
- /*
- * If the main thread Id has not been set, do it now.
- */
- Tcl_MutexLock(&threadMutex);
- if (mainThreadId == 0) {
- mainThreadId = Tcl_GetCurrentThread();
- }
- Tcl_MutexUnlock(&threadMutex);
-
- Tcl_CreateObjCommand(interp, "testthread", ThreadObjCmd, NULL, NULL);
+ Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd,
+ (ClientData) NULL, NULL);
return TCL_OK;
}
@@ -179,17 +169,15 @@ TclThread_Init(
/*
*----------------------------------------------------------------------
*
- * ThreadObjCmd --
+ * Tcl_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 ?-async? id script
- * thread event
+ * thread send id ?-async? script
* thread exit
- * thread id ?-main?
+ * thread info id
* thread names
* thread wait
* thread errorproc proc
@@ -205,8 +193,8 @@ TclThread_Init(
*/
/* ARGSUSED */
-static int
-ThreadObjCmd(
+int
+Tcl_ThreadObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
@@ -214,19 +202,17 @@ ThreadObjCmd(
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int option;
- static const char *const threadOptions[] = {
- "cancel", "create", "event", "exit", "id",
- "join", "names", "send", "wait", "errorproc",
- NULL
+ static const char *threadOptions[] = {
+ "create", "exit", "id", "join", "names",
+ "send", "wait", "errorproc", NULL
};
enum options {
- THREAD_CANCEL, THREAD_CREATE, THREAD_EVENT, THREAD_EXIT,
- THREAD_ID, THREAD_JOIN, THREAD_NAMES, THREAD_SEND,
- THREAD_WAIT, THREAD_ERRORPROC
+ THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, THREAD_NAMES,
+ THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC
};
if (objc < 2) {
- Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
+ Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0,
@@ -247,34 +233,6 @@ 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;
@@ -294,8 +252,9 @@ 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 {
@@ -311,14 +270,17 @@ 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 ThreadCreate(interp, script, joinable);
+ return TclCreateThread(interp, script, joinable);
}
case THREAD_EXIT:
if (objc > 2) {
@@ -329,24 +291,8 @@ ThreadObjCmd(
Tcl_ExitThread(0);
return TCL_OK;
case THREAD_ID:
- 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;
- }
+ if (objc == 2) {
+ Tcl_Obj *idObj = Tcl_NewWideIntObj((Tcl_WideInt)(size_t) Tcl_GetCurrentThread());
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
@@ -366,11 +312,11 @@ 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);
@@ -382,7 +328,7 @@ ThreadObjCmd(
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
- return ThreadList(interp);
+ return TclThreadList(interp);
case THREAD_SEND: {
Tcl_WideInt id;
const char *script;
@@ -408,23 +354,14 @@ ThreadObjCmd(
}
arg++;
script = Tcl_GetString(objv[arg]);
- 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;
+ return TclThreadSend(interp, (Tcl_ThreadId)(size_t)id, script, wait);
}
case THREAD_ERRORPROC: {
/*
* Arrange for this proc to handle thread death errors.
*/
- const char *proc;
+ char *proc;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "proc");
@@ -436,41 +373,15 @@ 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;
}
@@ -478,7 +389,7 @@ ThreadObjCmd(
/*
*----------------------------------------------------------------------
*
- * ThreadCreate --
+ * TclCreateThread --
*
* This procedure is invoked to create a thread containing an interp to
* run a script. This returns after the thread has started executing.
@@ -493,8 +404,8 @@ ThreadObjCmd(
*/
/* ARGSUSED */
-static int
-ThreadCreate(
+int
+TclCreateThread(
Tcl_Interp *interp, /* Current interpreter. */
const char *script, /* Script to execute */
int joinable) /* Flag, joinable thread or not */
@@ -512,7 +423,7 @@ ThreadCreate(
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;
}
@@ -559,20 +470,18 @@ Tcl_ThreadCreateType
NewTestThread(
ClientData clientData)
{
- ThreadCtrl *ctrlPtr = clientData;
+ ThreadCtrl *ctrlPtr = (ThreadCtrl*)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);
- if (result != TCL_OK) {
- ThreadErrorProc(tsdPtr->interp);
- }
+ result = TclThread_Init(tsdPtr->interp);
/*
* This is part of the test facility. Initialize _ALL_ test commands for
@@ -580,9 +489,6 @@ NewTestThread(
*/
result = Tcltest_Init(tsdPtr->interp);
- if (result != TCL_OK) {
- ThreadErrorProc(tsdPtr->interp);
- }
/*
* Update the list of threads.
@@ -596,10 +502,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, threadEvalScript);
+ Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
/*
* Notify the parent we are alive.
@@ -612,7 +518,7 @@ NewTestThread(
* Run the script.
*/
- Tcl_Preserve(tsdPtr->interp);
+ Tcl_Preserve((ClientData) tsdPtr->interp);
result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
@@ -622,9 +528,9 @@ NewTestThread(
* Clean up.
*/
- Tcl_DeleteInterp(tsdPtr->interp);
- Tcl_Release(tsdPtr->interp);
ListRemove(tsdPtr);
+ Tcl_Release((ClientData) tsdPtr->interp);
+ Tcl_DeleteInterp(tsdPtr->interp);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
@@ -654,7 +560,6 @@ 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);
@@ -670,7 +575,7 @@ ThreadErrorProc(
argv[1] = buf;
argv[2] = errorInfo;
script = Tcl_Merge(3, argv);
- ThreadSend(interp, errorThreadId, script, 0);
+ TclThreadSend(interp, errorThreadId, script, 0);
ckfree(script);
}
}
@@ -743,14 +648,13 @@ ListRemove(
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
- tsdPtr->interp = NULL;
Tcl_MutexUnlock(&threadMutex);
}
/*
*------------------------------------------------------------------------
*
- * ThreadList --
+ * TclThreadList --
*
* Return a list of threads running Tcl interpreters.
*
@@ -762,8 +666,8 @@ ListRemove(
*
*------------------------------------------------------------------------
*/
-static int
-ThreadList(
+int
+TclThreadList(
Tcl_Interp *interp)
{
ThreadSpecificData *tsdPtr;
@@ -783,7 +687,7 @@ ThreadList(
/*
*------------------------------------------------------------------------
*
- * ThreadSend --
+ * TclThreadSend --
*
* Send a script to another thread.
*
@@ -796,8 +700,8 @@ ThreadList(
*------------------------------------------------------------------------
*/
-static int
-ThreadSend(
+int
+TclThreadSend(
Tcl_Interp *interp, /* The current interpreter. */
Tcl_ThreadId id, /* Thread Id of other interpreter. */
const char *script, /* The script to evaluate. */
@@ -833,7 +737,7 @@ ThreadSend(
*/
if (threadId == Tcl_GetCurrentThread()) {
- Tcl_MutexUnlock(&threadMutex);
+ Tcl_MutexUnlock(&threadMutex);
return Tcl_GlobalEval(interp, script);
}
@@ -841,13 +745,13 @@ ThreadSend(
* Create the event for its event queue.
*/
- threadEventPtr = ckalloc(sizeof(ThreadEvent));
+ threadEventPtr = (ThreadEvent *) ckalloc(sizeof(ThreadEvent));
threadEventPtr->script = ckalloc(strlen(script) + 1);
strcpy(threadEventPtr->script, script);
if (!wait) {
resultPtr = threadEventPtr->resultPtr = NULL;
} else {
- resultPtr = ckalloc(sizeof(ThreadEventResult));
+ resultPtr = (ThreadEventResult *) ckalloc(sizeof(ThreadEventResult));
threadEventPtr->resultPtr = resultPtr;
/*
@@ -880,7 +784,7 @@ ThreadSend(
*/
threadEventPtr->event.proc = ThreadEventProc;
- Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
+ Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr,
TCL_QUEUE_TAIL);
Tcl_ThreadAlert(threadId);
@@ -895,7 +799,7 @@ ThreadSend(
Tcl_ResetResult(interp);
while (resultPtr->result == NULL) {
- Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
+ Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
}
/*
@@ -926,12 +830,11 @@ ThreadSend(
ckfree(resultPtr->errorInfo);
}
}
- Tcl_AppendResult(interp, resultPtr->result, NULL);
+ Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC);
Tcl_ConditionFinalize(&resultPtr->done);
code = resultPtr->code;
- ckfree(resultPtr->result);
- ckfree(resultPtr);
+ ckfree((char *) resultPtr);
return code;
}
@@ -939,62 +842,6 @@ ThreadSend(
/*
*------------------------------------------------------------------------
*
- * 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.
@@ -1014,7 +861,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;
@@ -1026,11 +873,13 @@ ThreadEventProc(
errorCode = "THREAD";
errorInfo = "";
} else {
- Tcl_Preserve(interp);
+ Tcl_Preserve((ClientData) interp);
Tcl_ResetResult(interp);
- Tcl_CreateThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
+ Tcl_CreateThreadExitHandler(ThreadFreeProc,
+ (ClientData) threadEventPtr->script);
code = Tcl_GlobalEval(interp, threadEventPtr->script);
- Tcl_DeleteThreadExitHandler(ThreadFreeProc, threadEventPtr->script);
+ Tcl_DeleteThreadExitHandler(ThreadFreeProc,
+ (ClientData) threadEventPtr->script);
if (code != TCL_OK) {
errorCode = Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY);
errorInfo = Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY);
@@ -1057,7 +906,7 @@ ThreadEventProc(
Tcl_MutexUnlock(&threadMutex);
}
if (interp != NULL) {
- Tcl_Release(interp);
+ Tcl_Release((ClientData) interp);
}
return 1;
}
@@ -1085,7 +934,7 @@ ThreadFreeProc(
ClientData clientData)
{
if (clientData) {
- ckfree(clientData);
+ ckfree((char *) clientData);
}
}
@@ -1113,7 +962,7 @@ ThreadDeleteEvent(
ClientData clientData) /* dummy */
{
if (eventPtr->proc == ThreadEventProc) {
- ckfree(((ThreadEvent *) eventPtr)->script);
+ ckfree((char *) ((ThreadEvent *) eventPtr)->script);
return 1;
}
@@ -1147,22 +996,17 @@ static void
ThreadExitProc(
ClientData clientData)
{
- char *threadEvalScript = clientData;
+ char *threadEvalScript = (char *) 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(threadEvalScript);
+ ckfree((char *) threadEvalScript);
threadEvalScript = NULL;
}
- Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);
+ Tcl_DeleteEvents((Tcl_EventDeleteProc *)ThreadDeleteEvent, NULL);
for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
nextPtr = resultPtr->nextPtr;
@@ -1182,7 +1026,7 @@ ThreadExitProc(
}
resultPtr->nextPtr = resultPtr->prevPtr = 0;
resultPtr->eventPtr->resultPtr = NULL;
- ckfree(resultPtr);
+ ckfree((char *) resultPtr);
} else if (resultPtr->dstThreadId == self) {
/*
* Dang. The target is going away. Unblock the caller. The result
@@ -1192,7 +1036,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);
generated by cgit v0.12 at 2024-08-29 00:30:49 (GMT)