diff options
Diffstat (limited to 'generic/tclThreadTest.c')
| -rw-r--r-- | generic/tclThreadTest.c | 599 |
1 files changed, 314 insertions, 285 deletions
diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index d298e5b..960c7dc 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -1,29 +1,31 @@ -/* +/* * tclThreadTest.c -- * - * This file implements the testthread command. Eventually this - * should be tclThreadCmd.c + * This file implements the testthread command. Eventually this should be + * tclThreadCmd.c * Some of this code is based on work done by Richard Hipp on behalf of * Conservation Through Innovation, Limited, with their permission. * * Copyright (c) 1998 by Sun Microsystems, Inc. * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. + * See the file "license.terms" for information on usage and redistribution of + * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ #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 instance of this structure per thread even if that thread contains - * multiple interpreters. The interpreter identified by this structure is - * the main interpreter for the thread. - * - * The main interpreter is the one that will process any messages - * received by a thread. Any thread can send messages but only the - * main interpreter can receive them. + * Each thread has an single instance of the following structure. There is one + * instance of this structure per thread even if that thread contains multiple + * interpreters. The interpreter identified by this structure is the main + * interpreter for the thread. + * + * The main interpreter is the one that will process any messages received by + * a thread. Any thread can send messages but only the main interpreter can + * receive them. */ typedef struct ThreadSpecificData { @@ -36,8 +38,8 @@ typedef struct ThreadSpecificData { static Tcl_ThreadDataKey dataKey; /* - * This list is used to list all threads that have interpreters. - * This is protected by threadMutex. + * This list is used to list all threads that have interpreters. This is + * protected by threadMutex. */ static struct ThreadSpecificData *threadList; @@ -55,16 +57,18 @@ static struct ThreadSpecificData *threadList; */ typedef struct ThreadCtrl { - char *script; /* The TCL command this thread should execute */ - int flags; /* Initial value of the "flags" field in the - * ThreadSpecificData structure for the new thread. - * Might contain TP_Detached or TP_TclThread. */ - Tcl_Condition condWait; - /* This condition variable is used to synchronize - * the parent and child threads. The child won't run - * until it acquires threadMutex, and the parent function - * won't complete until signaled on this condition - * variable. */ + char *script; /* The Tcl command this thread should + * execute */ + int flags; /* Initial value of the "flags" field in the + * ThreadSpecificData structure for the new + * thread. Might contain TP_Detached or + * TP_TclThread. */ + Tcl_Condition condWait; /* This condition variable is used to + * synchronize the parent and child threads. + * The child won't run until it acquires + * threadMutex, and the parent function won't + * complete until signaled on this condition + * variable. */ } ThreadCtrl; /* @@ -75,8 +79,8 @@ typedef struct ThreadEvent { Tcl_Event event; /* Must be first */ char *script; /* The script to execute. */ struct ThreadEventResult *resultPtr; - /* To communicate the result. This is - * NULL if we don't care about it. */ + /* To communicate the result. This is NULL if + * we don't care about it. */ } ThreadEvent; typedef struct ThreadEventResult { @@ -102,9 +106,9 @@ static ThreadEventResult *resultList; static Tcl_ThreadId errorThreadId; static char *errorProcString; -/* - * Access to the list of threads and to the thread send results is - * guarded by this mutex. +/* + * Access to the list of threads and to the thread send results is guarded by + * this mutex. */ TCL_DECLARE_MUTEX(threadMutex) @@ -112,28 +116,28 @@ TCL_DECLARE_MUTEX(threadMutex) #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLEXPORT -EXTERN int TclThread_Init _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int Tcl_ThreadObjCmd _ANSI_ARGS_((ClientData clientData, - Tcl_Interp *interp, int objc, Tcl_Obj *CONST objv[])); -EXTERN int TclCreateThread _ANSI_ARGS_((Tcl_Interp *interp, - char *script, int joinable)); -EXTERN int TclThreadList _ANSI_ARGS_((Tcl_Interp *interp)); -EXTERN int TclThreadSend _ANSI_ARGS_((Tcl_Interp *interp, Tcl_ThreadId id, - char *script, int wait)); +EXTERN int TclThread_Init(Tcl_Interp *interp); +EXTERN int Tcl_ThreadObjCmd(ClientData clientData, + Tcl_Interp *interp, int objc, + Tcl_Obj *const objv[]); +EXTERN int TclCreateThread(Tcl_Interp *interp, char *script, + int joinable); +EXTERN int TclThreadList(Tcl_Interp *interp); +EXTERN int TclThreadSend(Tcl_Interp *interp, Tcl_ThreadId id, + char *script, int wait); #undef TCL_STORAGE_CLASS #define TCL_STORAGE_CLASS DLLIMPORT -Tcl_ThreadCreateType NewTestThread _ANSI_ARGS_((ClientData clientData)); -static void ListRemove _ANSI_ARGS_((ThreadSpecificData *tsdPtr)); -static void ListUpdateInner _ANSI_ARGS_((ThreadSpecificData *tsdPtr)); -static int ThreadEventProc _ANSI_ARGS_((Tcl_Event *evPtr, int mask)); -static void ThreadErrorProc _ANSI_ARGS_((Tcl_Interp *interp)); -static void ThreadFreeProc _ANSI_ARGS_((ClientData clientData)); -static int ThreadDeleteEvent _ANSI_ARGS_((Tcl_Event *eventPtr, - ClientData clientData)); -static void ThreadExitProc _ANSI_ARGS_((ClientData clientData)); - +Tcl_ThreadCreateType NewTestThread(ClientData clientData); +static void ListRemove(ThreadSpecificData *tsdPtr); +static void ListUpdateInner(ThreadSpecificData *tsdPtr); +static int ThreadEventProc(Tcl_Event *evPtr, int mask); +static void ThreadErrorProc(Tcl_Interp *interp); +static void ThreadFreeProc(ClientData clientData); +static int ThreadDeleteEvent(Tcl_Event *eventPtr, + ClientData clientData); +static void ThreadExitProc(ClientData clientData); /* *---------------------------------------------------------------------- @@ -152,15 +156,12 @@ static void ThreadExitProc _ANSI_ARGS_((ClientData clientData)); */ int -TclThread_Init(interp) - Tcl_Interp *interp; /* The current Tcl interpreter */ +TclThread_Init( + Tcl_Interp *interp) /* The current Tcl interpreter */ { - - Tcl_CreateObjCommand(interp,"testthread", Tcl_ThreadObjCmd, - (ClientData)NULL ,NULL); - if (Tcl_PkgProvide(interp, "Thread", "1.0" ) != TCL_OK) { - return TCL_ERROR; - } + + Tcl_CreateObjCommand(interp, "testthread", Tcl_ThreadObjCmd, + (ClientData) NULL, NULL); return TCL_OK; } @@ -170,8 +171,8 @@ TclThread_Init(interp) * * Tcl_ThreadObjCmd -- * - * This procedure is invoked to process the "testthread" Tcl command. - * See the user documentation for details on what it does. + * This procedure is invoked to process the "testthread" Tcl command. See + * the user documentation for details on what it does. * * thread create ?-joinable? ?script? * thread send id ?-async? script @@ -193,30 +194,33 @@ TclThread_Init(interp) /* ARGSUSED */ int -Tcl_ThreadObjCmd(dummy, interp, objc, objv) - ClientData dummy; /* Not used. */ - Tcl_Interp *interp; /* Current interpreter. */ - int objc; /* Number of arguments. */ - Tcl_Obj *CONST objv[]; /* Argument objects. */ +Tcl_ThreadObjCmd( + ClientData dummy, /* Not used. */ + Tcl_Interp *interp, /* Current interpreter. */ + int objc, /* Number of arguments. */ + Tcl_Obj *const objv[]) /* Argument objects. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); int option; - static CONST char *threadOptions[] = {"create", "exit", "id", "join", "names", - "send", "wait", "errorproc", - (char *) NULL}; - enum options {THREAD_CREATE, THREAD_EXIT, THREAD_ID, THREAD_JOIN, - THREAD_NAMES, THREAD_SEND, THREAD_WAIT, THREAD_ERRORPROC}; + static const char *threadOptions[] = { + "create", "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 + }; if (objc < 2) { Tcl_WrongNumArgs(interp, 1, objv, "option ?args?"); return TCL_ERROR; } - if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, - "option", 0, &option) != TCL_OK) { + if (Tcl_GetIndexFromObj(interp, objv[1], threadOptions, "option", 0, + &option) != TCL_OK) { return TCL_ERROR; } - /* + /* * Make sure the initial thread is on the list before doing anything. */ @@ -229,158 +233,158 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) } switch ((enum options)option) { - case THREAD_CREATE: { - char *script; - int joinable, len; - - if (objc == 2) { - /* Neither joinable nor special script - */ + case THREAD_CREATE: { + char *script; + int joinable, len; - joinable = 0; - script = "testthread wait"; /* Just enter the event loop */ + if (objc == 2) { + /* + * Neither joinable nor special script + */ - } else if (objc == 3) { - /* Possibly -joinable, then no special script, - * no joinable, then its a script. - */ + joinable = 0; + script = "testthread wait"; /* Just enter event loop */ + } else if (objc == 3) { + /* + * Possibly -joinable, then no special script, no joinable, then + * its a script. + */ - script = Tcl_GetString(objv[2]); - len = strlen (script); + script = Tcl_GetStringFromObj(objv[2], &len); - if ((len > 1) && + if ((len > 1) && (script [0] == '-') && (script [1] == 'j') && (0 == strncmp (script, "-joinable", (size_t) len))) { - joinable = 1; - script = "testthread wait"; /* Just enter the event loop - */ - } else { - /* Remember the script */ - joinable = 0; - } - } else if (objc == 4) { - /* Definitely a script available, but is the flag - * -joinable ? + joinable = 1; + script = "testthread wait"; /* Just enter event loop */ + } else { + /* + * Remember the script */ - script = Tcl_GetString(objv[2]); - len = strlen (script); + joinable = 0; + } + } else if (objc == 4) { + /* + * Definitely a script available, but is the flag -joinable? + */ - joinable = ((len > 1) && - (script [0] == '-') && (script [1] == 'j') && - (0 == strncmp (script, "-joinable", (size_t) len))); + script = Tcl_GetStringFromObj(objv[2], &len); - script = Tcl_GetString(objv[3]); - } else { - Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?"); - return TCL_ERROR; - } - return TclCreateThread(interp, script, joinable); + 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; } - case THREAD_EXIT: { - if (objc > 2) { - Tcl_WrongNumArgs(interp, 1, objv, NULL); - return TCL_ERROR; - } - ListRemove(NULL); - Tcl_ExitThread(0); - return TCL_OK; + return TclCreateThread(interp, script, joinable); + } + case THREAD_EXIT: + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; } - case THREAD_ID: - if (objc == 2) { - Tcl_Obj *idObj = Tcl_NewLongObj((long)Tcl_GetCurrentThread()); - Tcl_SetObjResult(interp, idObj); - return TCL_OK; - } else { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - case THREAD_JOIN: { - long id; - int result, status; + ListRemove(NULL); + Tcl_ExitThread(0); + return TCL_OK; + case THREAD_ID: + if (objc == 2) { + Tcl_Obj *idObj = Tcl_NewLongObj((long) Tcl_GetCurrentThread()); - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "join id"); - return TCL_ERROR; - } - if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { - return TCL_ERROR; - } + Tcl_SetObjResult(interp, idObj); + return TCL_OK; + } else { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } + case THREAD_JOIN: { + long id; + int result, status; - result = Tcl_JoinThread ((Tcl_ThreadId) id, &status); - if (result == TCL_OK) { - Tcl_SetIntObj (Tcl_GetObjResult (interp), status); - } else { - char buf [20]; - sprintf (buf, "%ld", id); - Tcl_AppendResult (interp, "cannot join thread ", buf, NULL); - } - return result; + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "id"); + return TCL_ERROR; } - case THREAD_NAMES: { - if (objc > 2) { - Tcl_WrongNumArgs(interp, 2, objv, NULL); - return TCL_ERROR; - } - return TclThreadList(interp); + if (Tcl_GetLongFromObj(interp, objv[2], &id) != TCL_OK) { + return TCL_ERROR; } - case THREAD_SEND: { - long id; - char *script; - int wait, arg; - if ((objc != 4) && (objc != 5)) { - Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script"); - return TCL_ERROR; - } - if (objc == 5) { - if (strcmp("-async", Tcl_GetString(objv[2])) != 0) { - Tcl_WrongNumArgs(interp, 1, objv, "send ?-async? id script"); - return TCL_ERROR; - } - wait = 0; - arg = 3; - } else { - wait = 1; - arg = 2; - } - if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + result = Tcl_JoinThread ((Tcl_ThreadId) id, &status); + if (result == TCL_OK) { + Tcl_SetIntObj (Tcl_GetObjResult (interp), status); + } else { + char buf [20]; + + sprintf(buf, "%ld", id); + Tcl_AppendResult(interp, "cannot join thread ", buf, NULL); + } + return result; + } + case THREAD_NAMES: + if (objc > 2) { + Tcl_WrongNumArgs(interp, 2, objv, NULL); + return TCL_ERROR; + } + return TclThreadList(interp); + case THREAD_SEND: { + long id; + char *script; + int wait, arg; + + if ((objc != 4) && (objc != 5)) { + Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script"); + return TCL_ERROR; + } + if (objc == 5) { + if (strcmp("-async", Tcl_GetString(objv[2])) != 0) { + Tcl_WrongNumArgs(interp, 2, objv, "?-async? id script"); return TCL_ERROR; } - arg++; - script = Tcl_GetString(objv[arg]); - return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait); + wait = 0; + arg = 3; + } else { + wait = 1; + arg = 2; } - case THREAD_WAIT: { - while (1) { - (void) Tcl_DoOneEvent(TCL_ALL_EVENTS); - } + if (Tcl_GetLongFromObj(interp, objv[arg], &id) != TCL_OK) { + return TCL_ERROR; } - case THREAD_ERRORPROC: { - /* - * Arrange for this proc to handle thread death errors. - */ + arg++; + script = Tcl_GetString(objv[arg]); + return TclThreadSend(interp, (Tcl_ThreadId) id, script, wait); + } + case THREAD_ERRORPROC: { + /* + * Arrange for this proc to handle thread death errors. + */ - char *proc; - if (objc != 3) { - Tcl_WrongNumArgs(interp, 1, objv, "errorproc proc"); - return TCL_ERROR; - } - Tcl_MutexLock(&threadMutex); - errorThreadId = Tcl_GetCurrentThread(); - if (errorProcString) { - ckfree(errorProcString); - } - proc = Tcl_GetString(objv[2]); - errorProcString = ckalloc(strlen(proc)+1); - strcpy(errorProcString, proc); - Tcl_MutexUnlock(&threadMutex); - return TCL_OK; + char *proc; + + if (objc != 3) { + Tcl_WrongNumArgs(interp, 2, objv, "proc"); + return TCL_ERROR; + } + Tcl_MutexLock(&threadMutex); + errorThreadId = Tcl_GetCurrentThread(); + if (errorProcString) { + ckfree(errorProcString); + } + proc = Tcl_GetString(objv[2]); + errorProcString = ckalloc(strlen(proc)+1); + strcpy(errorProcString, proc); + Tcl_MutexUnlock(&threadMutex); + return TCL_OK; + } + case THREAD_WAIT: + while (1) { + (void) Tcl_DoOneEvent(TCL_ALL_EVENTS); } } return TCL_OK; } - /* *---------------------------------------------------------------------- @@ -388,7 +392,7 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) * TclCreateThread -- * * This procedure is invoked to create a thread containing an interp to - * run a script. This returns after the thread has started executing. + * run a script. This returns after the thread has started executing. * * Results: * A standard Tcl result, which is the thread ID. @@ -401,10 +405,10 @@ Tcl_ThreadObjCmd(dummy, interp, objc, objv) /* ARGSUSED */ int -TclCreateThread(interp, script, joinable) - Tcl_Interp *interp; /* Current interpreter. */ - char *script; /* Script to execute */ - int joinable; /* Flag, joinable thread or not */ +TclCreateThread( + Tcl_Interp *interp, /* Current interpreter. */ + char *script, /* Script to execute */ + int joinable) /* Flag, joinable thread or not */ { ThreadCtrl ctrl; Tcl_ThreadId id; @@ -417,10 +421,10 @@ TclCreateThread(interp, script, joinable) Tcl_MutexLock(&threadMutex); if (Tcl_CreateThread(&id, NewTestThread, (ClientData) &ctrl, - TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) { + TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) { Tcl_MutexUnlock(&threadMutex); - Tcl_AppendResult(interp,"can't create a new thread",NULL); - ckfree((void*)ctrl.script); + Tcl_AppendResult(interp, "can't create a new thread", NULL); + ckfree((char *) ctrl.script); return TCL_ERROR; } @@ -440,32 +444,32 @@ TclCreateThread(interp, script, joinable) * * NewTestThread -- * - * This routine is the "main()" for a new thread whose task is to - * execute a single TCL script. The argument to this function is - * a pointer to a structure that contains the text of the TCL script - * to be executed. - * - * Space to hold the script field of the ThreadControl structure passed - * in as the only argument was obtained from malloc() and must be freed - * by this function before it exits. Space to hold the ThreadControl - * structure itself is released by the calling function, and the - * two condition variables in the ThreadControl structure are destroyed - * by the calling function. The calling function will destroy the - * ThreadControl structure and the condition variable as soon as - * ctrlPtr->condWait is signaled, so this routine must make copies of - * any data it might need after that point. + * This routine is the "main()" for a new thread whose task is to execute + * a single Tcl script. The argument to this function is a pointer to a + * structure that contains the text of the TCL script to be executed. + * + * Space to hold the script field of the ThreadControl structure passed + * in as the only argument was obtained from malloc() and must be freed + * by this function before it exits. Space to hold the ThreadControl + * structure itself is released by the calling function, and the two + * condition variables in the ThreadControl structure are destroyed by + * the calling function. The calling function will destroy the + * ThreadControl structure and the condition variable as soon as + * ctrlPtr->condWait is signaled, so this routine must make copies of any + * data it might need after that point. * * Results: - * none + * None * * Side effects: - * A TCL script is executed in a new thread. + * A Tcl script is executed in a new thread. * *------------------------------------------------------------------------ */ + Tcl_ThreadCreateType -NewTestThread(clientData) - ClientData clientData; +NewTestThread( + ClientData clientData) { ThreadCtrl *ctrlPtr = (ThreadCtrl*)clientData; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); @@ -481,16 +485,25 @@ NewTestThread(clientData) result = TclThread_Init(tsdPtr->interp); /* + * This is part of the test facility. Initialize _ALL_ test commands for + * use by the new thread. + */ + + result = Tcltest_Init(tsdPtr->interp); + + /* * Update the list of threads. */ Tcl_MutexLock(&threadMutex); ListUpdateInner(tsdPtr); + /* - * We need to keep a pointer to the alloc'ed mem of the script - * we are eval'ing, for the case that we exit during evaluation + * We need to keep a pointer to the alloc'ed mem of the script we are + * eval'ing, for the case that we exit during evaluation */ - threadEvalScript = (char *) ckalloc(strlen(ctrlPtr->script)+1); + + threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1); strcpy(threadEvalScript, ctrlPtr->script); Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript); @@ -529,22 +542,23 @@ NewTestThread(clientData) * * ThreadErrorProc -- * - * Send a message to the thread willing to hear about errors. + * Send a message to the thread willing to hear about errors. * * Results: - * none + * None * * Side effects: - * Send an event. + * Send an event. * *------------------------------------------------------------------------ */ + static void -ThreadErrorProc(interp) - Tcl_Interp *interp; /* Interp that failed */ +ThreadErrorProc( + Tcl_Interp *interp) /* Interp that failed */ { Tcl_Channel errChannel; - CONST char *errorInfo, *argv[3]; + const char *errorInfo, *argv[3]; char *script; char buf[TCL_DOUBLE_SPACE+1]; sprintf(buf, "%ld", (long) Tcl_GetCurrentThread()); @@ -573,20 +587,21 @@ ThreadErrorProc(interp) * * ListUpdateInner -- * - * Add the thread local storage to the list. This assumes - * the caller has obtained the mutex. + * Add the thread local storage to the list. This assumes the caller has + * obtained the mutex. * * Results: - * none + * None * * Side effects: - * Add the thread local storage to its list. + * Add the thread local storage to its list. * *------------------------------------------------------------------------ */ + static void -ListUpdateInner(tsdPtr) - ThreadSpecificData *tsdPtr; +ListUpdateInner( + ThreadSpecificData *tsdPtr) { if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -605,20 +620,21 @@ ListUpdateInner(tsdPtr) * * ListRemove -- * - * Remove the thread local storage from its list. This grabs the - * mutex to protect the list. + * Remove the thread local storage from its list. This grabs the mutex to + * protect the list. * * Results: - * none + * None * * Side effects: - * Remove the thread local storage from its list. + * Remove the thread local storage from its list. * *------------------------------------------------------------------------ */ + static void -ListRemove(tsdPtr) - ThreadSpecificData *tsdPtr; +ListRemove( + ThreadSpecificData *tsdPtr) { if (tsdPtr == NULL) { tsdPtr = TCL_TSD_INIT(&dataKey); @@ -635,7 +651,6 @@ ListRemove(tsdPtr) tsdPtr->nextPtr = tsdPtr->prevPtr = 0; Tcl_MutexUnlock(&threadMutex); } - /* *------------------------------------------------------------------------ @@ -653,8 +668,8 @@ ListRemove(tsdPtr) *------------------------------------------------------------------------ */ int -TclThreadList(interp) - Tcl_Interp *interp; +TclThreadList( + Tcl_Interp *interp) { ThreadSpecificData *tsdPtr; Tcl_Obj *listPtr; @@ -663,13 +678,12 @@ TclThreadList(interp) Tcl_MutexLock(&threadMutex); for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) { Tcl_ListObjAppendElement(interp, listPtr, - Tcl_NewLongObj((long)tsdPtr->threadId)); + Tcl_NewLongObj((long) tsdPtr->threadId)); } Tcl_MutexUnlock(&threadMutex); Tcl_SetObjResult(interp, listPtr); return TCL_OK; } - /* *------------------------------------------------------------------------ @@ -686,12 +700,13 @@ TclThreadList(interp) * *------------------------------------------------------------------------ */ + int -TclThreadSend(interp, id, script, wait) - Tcl_Interp *interp; /* The current interpreter. */ - Tcl_ThreadId id; /* Thread Id of other interpreter. */ - char *script; /* The script to evaluate. */ - int wait; /* If 1, we block for the result. */ +TclThreadSend( + Tcl_Interp *interp, /* The current interpreter. */ + Tcl_ThreadId id, /* Thread Id of other interpreter. */ + char *script, /* The script to evaluate. */ + int wait) /* If 1, we block for the result. */ { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr; @@ -699,7 +714,7 @@ TclThreadSend(interp, id, script, wait) int found, code; Tcl_ThreadId threadId = (Tcl_ThreadId) id; - /* + /* * Verify the thread exists. */ @@ -718,8 +733,8 @@ TclThreadSend(interp, id, script, wait) } /* - * Short circut sends to ourself. Ought to do something with -async, - * like run in an idle handler. + * Short circut sends to ourself. Ought to do something with -async, like + * run in an idle handler. */ if (threadId == Tcl_GetCurrentThread()) { @@ -727,7 +742,7 @@ TclThreadSend(interp, id, script, wait) return Tcl_GlobalEval(interp, script); } - /* + /* * Create the event for its event queue. */ @@ -750,7 +765,7 @@ TclThreadSend(interp, id, script, wait) resultPtr->errorInfo = NULL; resultPtr->errorCode = NULL; - /* + /* * Maintain the cleanup list. */ @@ -770,7 +785,7 @@ TclThreadSend(interp, id, script, wait) */ threadEventPtr->event.proc = ThreadEventProc; - Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, + Tcl_ThreadQueueEvent(threadId, (Tcl_Event *)threadEventPtr, TCL_QUEUE_TAIL); Tcl_ThreadAlert(threadId); @@ -779,7 +794,7 @@ TclThreadSend(interp, id, script, wait) return TCL_OK; } - /* + /* * Block on the results and then get them. */ @@ -824,7 +839,6 @@ TclThreadSend(interp, id, script, wait) return code; } - /* *------------------------------------------------------------------------ @@ -841,17 +855,18 @@ TclThreadSend(interp, id, script, wait) * *------------------------------------------------------------------------ */ + static int -ThreadEventProc(evPtr, mask) - Tcl_Event *evPtr; /* Really ThreadEvent */ - int mask; +ThreadEventProc( + Tcl_Event *evPtr, /* Really ThreadEvent */ + int mask) { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); ThreadEvent *threadEventPtr = (ThreadEvent *)evPtr; ThreadEventResult *resultPtr = threadEventPtr->resultPtr; Tcl_Interp *interp = tsdPtr->interp; int code; - CONST char *result, *errorCode, *errorInfo; + const char *result, *errorCode, *errorInfo; if (interp == NULL) { code = TCL_ERROR; @@ -913,10 +928,11 @@ ThreadEventProc(evPtr, mask) * *------------------------------------------------------------------------ */ + /* ARGSUSED */ static void -ThreadFreeProc(clientData) - ClientData clientData; +ThreadFreeProc( + ClientData clientData) { if (clientData) { ckfree((char *) clientData); @@ -939,20 +955,23 @@ ThreadFreeProc(clientData) * *------------------------------------------------------------------------ */ + /* ARGSUSED */ static int -ThreadDeleteEvent(eventPtr, clientData) - Tcl_Event *eventPtr; /* Really ThreadEvent */ - ClientData clientData; /* dummy */ +ThreadDeleteEvent( + Tcl_Event *eventPtr, /* Really ThreadEvent */ + ClientData clientData) /* dummy */ { if (eventPtr->proc == ThreadEventProc) { ckfree((char *) ((ThreadEvent *) eventPtr)->script); return 1; } + /* - * If it was NULL, we were in the middle of servicing the event - * and it should be removed + * If it was NULL, we were in the middle of servicing the event and it + * should be removed */ + return (eventPtr->proc == NULL); } @@ -961,21 +980,22 @@ ThreadDeleteEvent(eventPtr, clientData) * * ThreadExitProc -- * - * This is called when the thread exits. + * This is called when the thread exits. * * Results: * None. * * Side effects: - * It unblocks anyone that is waiting on a send to this thread. - * It cleans up any events in the event queue for this thread. + * It unblocks anyone that is waiting on a send to this thread. It cleans + * up any events in the event queue for this thread. * *------------------------------------------------------------------------ */ + /* ARGSUSED */ static void -ThreadExitProc(clientData) - ClientData clientData; +ThreadExitProc( + ClientData clientData) { char *threadEvalScript = (char *) clientData; ThreadEventResult *resultPtr, *nextPtr; @@ -993,9 +1013,10 @@ ThreadExitProc(clientData) nextPtr = resultPtr->nextPtr; if (resultPtr->srcThreadId == self) { /* - * We are going away. By freeing up the result we signal - * to the other thread we don't care about the result. + * We are going away. By freeing up the result we signal to the + * other thread we don't care about the result. */ + if (resultPtr->prevPtr) { resultPtr->prevPtr->nextPtr = resultPtr->nextPtr; } else { @@ -1006,15 +1027,16 @@ ThreadExitProc(clientData) } resultPtr->nextPtr = resultPtr->prevPtr = 0; resultPtr->eventPtr->resultPtr = NULL; - ckfree((char *)resultPtr); + ckfree((char *) resultPtr); } else if (resultPtr->dstThreadId == self) { /* - * Dang. The target is going away. Unblock the caller. - * The result string must be dynamically allocated because - * the main thread is going to call free on it. + * Dang. The target is going away. Unblock the caller. The result + * string must be dynamically allocated because the main thread is + * going to call free on it. */ char *msg = "target thread died"; + resultPtr->result = ckalloc(strlen(msg)+1); strcpy(resultPtr->result, msg); resultPtr->code = TCL_ERROR; @@ -1023,5 +1045,12 @@ ThreadExitProc(clientData) } Tcl_MutexUnlock(&threadMutex); } - #endif /* TCL_THREADS */ + +/* + * Local Variables: + * mode: c + * c-basic-offset: 4 + * fill-column: 78 + * End: + */ |