/*
* tclThreadTest.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 © 1998 Sun Microsystems, Inc.
* Copyright © 2006-2008 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.
*/
#undef BUILD_tcl
#undef STATIC_BUILD
#ifndef USE_TCL_STUBS
# define USE_TCL_STUBS
#endif
#include "tclInt.h"
#ifdef HAVE_UNISTD_H
# include <unistd.h>
# ifdef _POSIX_PRIORITY_SCHEDULING
# include <sched.h>
# endif
#endif
#if 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.
*/
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" */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;
/*
* This list is used to list all threads that have interpreters. This is
* protected by threadMutex.
*/
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 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 ThreadCreate() C function.
*/
typedef struct ThreadCtrl {
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
* 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;
/*
* This is the event used to send scripts to other threads.
*/
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. */
} ThreadEvent;
typedef struct ThreadEventResult {
Tcl_Condition done; /* Signaled when the script completes */
int code; /* Return value of Tcl_Eval */
char *result; /* Result from the script */
char *errorInfo; /* Copy of errorInfo variable */
char *errorCode; /* Copy of errorCode variable */
Tcl_ThreadId srcThreadId; /* Id of sending thread, in case it dies */
Tcl_ThreadId dstThreadId; /* Id of target thread, in case it dies */
struct ThreadEvent *eventPtr; /* Back pointer */
struct ThreadEventResult *nextPtr; /* List for cleanup */
struct ThreadEventResult *prevPtr;
} ThreadEventResult;
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;
/*
* Access to the list of threads and to the thread send results is guarded by
* this mutex.
*/
TCL_DECLARE_MUTEX(threadMutex)
static Tcl_ObjCmdProc ThreadCmd;
static int ThreadCreate(Tcl_Interp *interp, const char *script,
int joinable);
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);
static Tcl_ThreadCreateType NewTestThread(void *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(void *clientData);
static int ThreadDeleteEvent(Tcl_Event *eventPtr,
void *clientData);
static void ThreadExitProc(void *clientData);
/*
* Types related to Tcl_Mutex tests.
*/
TCL_DECLARE_MUTEX(testContextMutex)
static inline void LockTestContext(int numRecursions) {
for (int j = 0; j < numRecursions; ++j) {
Tcl_MutexLock(&testContextMutex);
}
}
static inline void UnlockTestContext(int numRecursions) {
for (int j = 0; j < numRecursions; ++j) {
Tcl_MutexUnlock(&testContextMutex);
}
}
/*
* ProducerConsumerContext is used in producer consumer tests to
* simulate a resource queue.
*/
typedef struct {
Tcl_Condition canEnqueue; /* Signal producer if queue not full */
Tcl_Condition canDequeue; /* Signal consumer if queue not empty */
Tcl_WideUInt totalEnqueued; /* Total enqueued so far */
Tcl_WideUInt totalDequeued; /* Total dequeued so far */
int available; /* Number of "resources" available */
int capacity; /* Max number allowed in queue */
} ProducerConsumerQueue;
#define CONDITION_TIMEOUT_SECS 1
/*
* MutexSharedContext holds context shared amongst all threads in a test.
* Should only be modified under testContextMutex lock unless only single
* thread has access.
*/
typedef struct {
int numThreads; /* Number of threads in test run */
int numRecursions; /* Number of mutex lock recursions */
int numIterations; /* Number of times each thread should loop */
int yield; /* Whether threads should yield when looping */
union {
Tcl_WideUInt counter; /* Used in lock tests */
ProducerConsumerQueue queue; /* Used in condition variable tests */
} u;
} MutexSharedContext;
/*
* MutexThreadContext holds context specific to each test thread. This
* is passed as the clientData argument to each test thread.
*/
typedef struct {
MutexSharedContext *sharedContextPtr; /* Pointer to shared context */
Tcl_ThreadId threadId; /* Only access in creator */
Tcl_WideUInt numOperations; /* Use is dependent on the test */
Tcl_WideUInt timeouts; /* Timeouts on condition variables */
} MutexThreadContext;
/* Used to track how many test threads running. Also used as trigger */
static volatile int mutexThreadCount;
static Tcl_ObjCmdProc TestMutexCmd;
static Tcl_ThreadCreateType CounterThreadProc(void *clientData);
static int TestMutexLock(Tcl_Interp *interp,
MutexSharedContext *contextPtr);
static int TestConditionVariable(Tcl_Interp *interp,
MutexSharedContext *contextPtr);
static Tcl_ThreadCreateType ConsumerThreadProc(void *clientData);
static Tcl_ThreadCreateType ProducerThreadProc(void *clientData);
#if defined(_WIN32)
static inline void YieldToOtherThreads() {
Sleep(0);
}
#elif defined(_POSIX_PRIORITY_SCHEDULING)
static inline void YieldToOtherThreads() {
(void)sched_yield();
}
#else
static inline void YieldToOtherThreads() {
volatile int i;
for (i = 0; i < 1000; ++i) {
/* Just some random delay */
}
}
#endif
#ifdef __cplusplus
extern "C" {
#endif
extern int Tcltest_Init(Tcl_Interp *interp);
#ifdef __cplusplus
}
#endif
/*
*----------------------------------------------------------------------
*
* TclThread_Init --
*
* Initialize the test thread command.
*
* Results:
* TCL_OK if the package was properly initialized.
*
* Side effects:
* Add the "testthread" command to the interp.
*
*----------------------------------------------------------------------
*/
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", ThreadCmd, NULL, NULL);
Tcl_CreateObjCommand(interp, "testmutex", TestMutexCmd, NULL, NULL);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ThreadCmd --
*
* 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 exit
* thread id ?-main?
* thread names
* thread wait
* thread errorproc proc
* thread join id
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ThreadCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
static const char *const threadOptions[] = {
"cancel", "create", "event", "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
} option;
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?arg ...?");
return TCL_ERROR;
}
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.
*/
if (tsdPtr->interp == NULL) {
Tcl_MutexLock(&threadMutex);
tsdPtr->interp = interp;
ListUpdateInner(tsdPtr);
Tcl_CreateThreadExitHandler(ThreadExitProc, NULL);
Tcl_MutexUnlock(&threadMutex);
}
switch (option) {
case THREAD_CANCEL: {
Tcl_WideInt 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_GetWideIntFromObj(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) INT2PTR(id), result, flags);
}
case THREAD_CREATE: {
const char *script;
int joinable;
Tcl_Size len;
if (objc == 2) {
/*
* Neither joinable nor special 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_GetStringFromObj(objv[2], &len);
if ((len > 1) && (script[0] == '-') && (script[1] == 'j') &&
(0 == strncmp(script, "-joinable", len))) {
joinable = 1;
script = "testthread wait"; /* Just enter event loop */
} else {
/*
* Remember the script
*/
joinable = 0;
}
} else if (objc == 4) {
/*
* Definitely a script available, but is the flag -joinable?
*/
script = Tcl_GetStringFromObj(objv[2], &len);
joinable = ((len > 1) && (script[0] == '-') && (script[1] == 'j')
&& (0 == strncmp(script, "-joinable", len)));
script = Tcl_GetString(objv[3]);
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-joinable? ?script?");
return TCL_ERROR;
}
return ThreadCreate(interp, script, joinable);
}
case THREAD_EXIT:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
ListRemove(NULL);
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)PTR2INT(Tcl_GetCurrentThread()));
} else if (objc == 3
&& strcmp("-main", Tcl_GetString(objv[2])) == 0) {
Tcl_MutexLock(&threadMutex);
idObj = Tcl_NewWideIntObj((Tcl_WideInt)PTR2INT(mainThreadId));
Tcl_MutexUnlock(&threadMutex);
} else {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, idObj);
return TCL_OK;
} else {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
case THREAD_JOIN: {
Tcl_WideInt id;
int result, status;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "id");
return TCL_ERROR;
}
if (Tcl_GetWideIntFromObj(interp, objv[2], &id) != TCL_OK) {
return TCL_ERROR;
}
result = Tcl_JoinThread((Tcl_ThreadId)INT2PTR(id), &status);
if (result == TCL_OK) {
Tcl_SetIntObj(Tcl_GetObjResult(interp), status);
} else {
char buf[TCL_INTEGER_SPACE];
snprintf(buf, sizeof(buf), "%" TCL_LL_MODIFIER "d", (long long)id);
Tcl_AppendResult(interp, "cannot join thread ", buf, (char *)NULL);
}
return result;
}
case THREAD_NAMES:
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
return ThreadList(interp);
case THREAD_SEND: {
Tcl_WideInt id;
const 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;
}
wait = 0;
arg = 3;
} else {
wait = 1;
arg = 2;
}
if (Tcl_GetWideIntFromObj(interp, objv[arg], &id) != TCL_OK) {
return TCL_ERROR;
}
arg++;
script = Tcl_GetString(objv[arg]);
return ThreadSend(interp, (Tcl_ThreadId)INT2PTR(id), script, wait);
}
case THREAD_EVENT: {
if (objc > 2) {
Tcl_WrongNumArgs(interp, 2, objv, NULL);
return TCL_ERROR;
}
Tcl_SetObjResult(interp, Tcl_NewWideIntObj(
Tcl_DoOneEvent(TCL_ALL_EVENTS | TCL_DONT_WAIT)));
return TCL_OK;
}
case THREAD_ERRORPROC: {
/*
* Arrange for this proc to handle thread death errors.
*/
const char *proc;
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "proc");
return TCL_ERROR;
}
Tcl_MutexLock(&threadMutex);
errorThreadId = Tcl_GetCurrentThread();
if (errorProcString) {
Tcl_Free(errorProcString);
}
proc = Tcl_GetString(objv[2]);
errorProcString = (char *)Tcl_Alloc(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;
}
/*
*----------------------------------------------------------------------
*
* ThreadCreate --
*
* This procedure is invoked to create a thread containing an interp to
* run a script. This returns after the thread has started executing.
*
* Results:
* A standard Tcl result, which is the thread ID.
*
* Side effects:
* Create a thread.
*
*----------------------------------------------------------------------
*/
static int
ThreadCreate(
Tcl_Interp *interp, /* Current interpreter. */
const char *script, /* Script to execute */
int joinable) /* Flag, joinable thread or not */
{
ThreadCtrl ctrl;
Tcl_ThreadId id;
ctrl.script = script;
ctrl.condWait = NULL;
ctrl.flags = 0;
joinable = joinable ? TCL_THREAD_JOINABLE : TCL_THREAD_NOFLAGS;
Tcl_MutexLock(&threadMutex);
if (Tcl_CreateThread(&id, NewTestThread, &ctrl,
TCL_THREAD_STACK_DEFAULT, joinable) != TCL_OK) {
Tcl_MutexUnlock(&threadMutex);
Tcl_AppendResult(interp, "cannot create a new thread", (char *)NULL);
return TCL_ERROR;
}
/*
* Wait for the thread to start because it is using something on our stack!
*/
Tcl_ConditionWait(&ctrl.condWait, &threadMutex, NULL);
Tcl_MutexUnlock(&threadMutex);
Tcl_ConditionFinalize(&ctrl.condWait);
Tcl_SetObjResult(interp, Tcl_NewWideIntObj((Tcl_WideInt)(size_t)id));
return TCL_OK;
}
/*
*------------------------------------------------------------------------
*
* 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.
*
* Results:
* None
*
* Side effects:
* A Tcl script is executed in a new thread.
*
*------------------------------------------------------------------------
*/
Tcl_ThreadCreateType
NewTestThread(
void *clientData)
{
ThreadCtrl *ctrlPtr = (ThreadCtrl *)clientData;
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
int result;
char *threadEvalScript;
/*
* Initialize the interpreter. This should be more general.
*/
tsdPtr->interp = Tcl_CreateInterp();
result = Tcl_Init(tsdPtr->interp);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
}
/*
* This is part of the test facility. Initialize _ALL_ test commands for
* use by the new thread.
*/
result = Tcltest_Init(tsdPtr->interp);
if (result != TCL_OK) {
ThreadErrorProc(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
*/
threadEvalScript = (char *)Tcl_Alloc(strlen(ctrlPtr->script) + 1);
strcpy(threadEvalScript, ctrlPtr->script);
Tcl_CreateThreadExitHandler(ThreadExitProc, threadEvalScript);
/*
* Notify the parent we are alive.
*/
Tcl_ConditionNotify(&ctrlPtr->condWait);
Tcl_MutexUnlock(&threadMutex);
/*
* Run the script.
*/
Tcl_Preserve(tsdPtr->interp);
result = Tcl_EvalEx(tsdPtr->interp, threadEvalScript, TCL_INDEX_NONE, 0);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
}
/*
* Clean up.
*/
Tcl_DeleteInterp(tsdPtr->interp);
Tcl_Release(tsdPtr->interp);
ListRemove(tsdPtr);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
}
/*
*------------------------------------------------------------------------
*
* ThreadErrorProc --
*
* Send a message to the thread willing to hear about errors.
*
* Results:
* None
*
* Side effects:
* Send an event.
*
*------------------------------------------------------------------------
*/
static void
ThreadErrorProc(
Tcl_Interp *interp) /* Interp that failed */
{
Tcl_Channel errChannel;
const char *errorInfo, *argv[3];
char *script;
char buf[TCL_DOUBLE_SPACE+1];
snprintf(buf, sizeof(buf), "%p", Tcl_GetCurrentThread());
errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
if (errorProcString == NULL) {
errChannel = Tcl_GetStdChannel(TCL_STDERR);
Tcl_WriteChars(errChannel, "Error from thread ", -1);
Tcl_WriteChars(errChannel, buf, -1);
Tcl_WriteChars(errChannel, "\n", 1);
Tcl_WriteChars(errChannel, errorInfo, -1);
Tcl_WriteChars(errChannel, "\n", 1);
} else {
argv[0] = errorProcString;
argv[1] = buf;
argv[2] = errorInfo;
script = Tcl_Merge(3, argv);
ThreadSend(interp, errorThreadId, script, 0);
Tcl_Free(script);
}
}
/*
*------------------------------------------------------------------------
*
* ListUpdateInner --
*
* Add the thread local storage to the list. This assumes the caller has
* obtained the mutex.
*
* Results:
* None
*
* Side effects:
* Add the thread local storage to its list.
*
*------------------------------------------------------------------------
*/
static void
ListUpdateInner(
ThreadSpecificData *tsdPtr)
{
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
}
tsdPtr->threadId = Tcl_GetCurrentThread();
tsdPtr->nextPtr = threadList;
if (threadList) {
threadList->prevPtr = tsdPtr;
}
tsdPtr->prevPtr = NULL;
threadList = tsdPtr;
}
/*
*------------------------------------------------------------------------
*
* ListRemove --
*
* Remove the thread local storage from its list. This grabs the mutex to
* protect the list.
*
* Results:
* None
*
* Side effects:
* Remove the thread local storage from its list.
*
*------------------------------------------------------------------------
*/
static void
ListRemove(
ThreadSpecificData *tsdPtr)
{
if (tsdPtr == NULL) {
tsdPtr = TCL_TSD_INIT(&dataKey);
}
Tcl_MutexLock(&threadMutex);
if (tsdPtr->prevPtr) {
tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
} else {
threadList = tsdPtr->nextPtr;
}
if (tsdPtr->nextPtr) {
tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
}
tsdPtr->nextPtr = tsdPtr->prevPtr = 0;
tsdPtr->interp = NULL;
Tcl_MutexUnlock(&threadMutex);
}
/*
*------------------------------------------------------------------------
*
* ThreadList --
*
* Return a list of threads running Tcl interpreters.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*------------------------------------------------------------------------
*/
static int
ThreadList(
Tcl_Interp *interp)
{
ThreadSpecificData *tsdPtr;
Tcl_Obj *listPtr;
listPtr = Tcl_NewListObj(0, NULL);
Tcl_MutexLock(&threadMutex);
for (tsdPtr = threadList ; tsdPtr ; tsdPtr = tsdPtr->nextPtr) {
Tcl_ListObjAppendElement(interp, listPtr,
Tcl_NewWideIntObj((Tcl_WideInt)(size_t)tsdPtr->threadId));
}
Tcl_MutexUnlock(&threadMutex);
Tcl_SetObjResult(interp, listPtr);
return TCL_OK;
}
/*
*------------------------------------------------------------------------
*
* ThreadSend --
*
* Send a script to another thread.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* None.
*
*------------------------------------------------------------------------
*/
static int
ThreadSend(
Tcl_Interp *interp, /* The current interpreter. */
Tcl_ThreadId id, /* Thread Id of other interpreter. */
const char *script, /* The script to evaluate. */
int wait) /* If 1, we block for the result. */
{
ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
ThreadEvent *threadEventPtr;
ThreadEventResult *resultPtr;
int found, code;
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", (char *)NULL);
return TCL_ERROR;
}
/*
* Short circuit sends to ourself. Ought to do something with -async, like
* run in an idle handler.
*/
if (threadId == Tcl_GetCurrentThread()) {
Tcl_MutexUnlock(&threadMutex);
return Tcl_EvalEx(interp, script,-1,TCL_EVAL_GLOBAL);
}
/*
* Create the event for its event queue.
*/
threadEventPtr = (ThreadEvent*)Tcl_Alloc(sizeof(ThreadEvent));
threadEventPtr->script = (char *)Tcl_Alloc(strlen(script) + 1);
strcpy(threadEventPtr->script, script);
if (!wait) {
resultPtr = threadEventPtr->resultPtr = NULL;
} else {
resultPtr = (ThreadEventResult *)Tcl_Alloc(sizeof(ThreadEventResult));
threadEventPtr->resultPtr = resultPtr;
/*
* Initialize the result fields.
*/
resultPtr->done = NULL;
resultPtr->code = 0;
resultPtr->result = NULL;
resultPtr->errorInfo = NULL;
resultPtr->errorCode = NULL;
/*
* Maintain the cleanup list.
*/
resultPtr->srcThreadId = Tcl_GetCurrentThread();
resultPtr->dstThreadId = threadId;
resultPtr->eventPtr = threadEventPtr;
resultPtr->nextPtr = resultList;
if (resultList) {
resultList->prevPtr = resultPtr;
}
resultPtr->prevPtr = NULL;
resultList = resultPtr;
}
/*
* Queue the event and poke the other thread's notifier.
*/
threadEventPtr->event.proc = ThreadEventProc;
Tcl_ThreadQueueEvent(threadId, (Tcl_Event *) threadEventPtr,
TCL_QUEUE_TAIL|TCL_QUEUE_ALERT_IF_EMPTY);
if (!wait) {
Tcl_MutexUnlock(&threadMutex);
return TCL_OK;
}
/*
* Block on the results and then get them.
*/
Tcl_ResetResult(interp);
while (resultPtr->result == NULL) {
Tcl_ConditionWait(&resultPtr->done, &threadMutex, NULL);
}
/*
* Unlink result from the result list.
*/
if (resultPtr->prevPtr) {
resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
} else {
resultList = resultPtr->nextPtr;
}
if (resultPtr->nextPtr) {
resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
}
resultPtr->eventPtr = NULL;
resultPtr->nextPtr = NULL;
resultPtr->prevPtr = NULL;
Tcl_MutexUnlock(&threadMutex);
if (resultPtr->code != TCL_OK) {
if (resultPtr->errorCode) {
Tcl_SetErrorCode(interp, resultPtr->errorCode, (char *)NULL);
Tcl_Free(resultPtr->errorCode);
}
if (resultPtr->errorInfo) {
Tcl_AddErrorInfo(interp, resultPtr->errorInfo);
Tcl_Free(resultPtr->errorInfo);
}
}
Tcl_AppendResult(interp, resultPtr->result, (char *)NULL);
Tcl_ConditionFinalize(&resultPtr->done);
code = resultPtr->code;
Tcl_Free(resultPtr->result);
Tcl_Free(resultPtr);
return code;
}
/*
*------------------------------------------------------------------------
*
* 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", (char *)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.
*
* Results:
* Returns 1 to indicate that the event was processed.
*
* Side effects:
* Fills out the ThreadEventResult struct.
*
*------------------------------------------------------------------------
*/
static int
ThreadEventProc(
Tcl_Event *evPtr, /* Really ThreadEvent */
TCL_UNUSED(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;
if (interp == NULL) {
code = TCL_ERROR;
result = "no target interp!";
errorCode = "THREAD";
errorInfo = "";
} else {
Tcl_Preserve(interp);
Tcl_ResetResult(interp);
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_GetVar2(interp, "errorCode", NULL, TCL_GLOBAL_ONLY);
errorInfo = Tcl_GetVar2(interp, "errorInfo", NULL, TCL_GLOBAL_ONLY);
} else {
errorCode = errorInfo = NULL;
}
result = Tcl_GetStringResult(interp);
}
Tcl_Free(threadEventPtr->script);
if (resultPtr) {
Tcl_MutexLock(&threadMutex);
resultPtr->code = code;
resultPtr->result = (char *)Tcl_Alloc(strlen(result) + 1);
strcpy(resultPtr->result, result);
if (errorCode != NULL) {
resultPtr->errorCode = (char *)Tcl_Alloc(strlen(errorCode) + 1);
strcpy(resultPtr->errorCode, errorCode);
}
if (errorInfo != NULL) {
resultPtr->errorInfo = (char *)Tcl_Alloc(strlen(errorInfo) + 1);
strcpy(resultPtr->errorInfo, errorInfo);
}
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&threadMutex);
}
if (interp != NULL) {
Tcl_Release(interp);
}
return 1;
}
/*
*------------------------------------------------------------------------
*
* ThreadFreeProc --
*
* This is called from when we are exiting and memory needs
* to be freed.
*
* Results:
* None.
*
* Side effects:
* Clears up mem specified in clientData
*
*------------------------------------------------------------------------
*/
static void
ThreadFreeProc(
void *clientData)
{
if (clientData) {
Tcl_Free(clientData);
}
}
/*
*------------------------------------------------------------------------
*
* ThreadDeleteEvent --
*
* This is called from the ThreadExitProc to delete memory related
* to events that we put on the queue.
*
* Results:
* 1 it was our event and we want it removed, 0 otherwise.
*
* Side effects:
* It cleans up our events in the event queue for this thread.
*
*------------------------------------------------------------------------
*/
static int
ThreadDeleteEvent(
Tcl_Event *eventPtr, /* Really ThreadEvent */
TCL_UNUSED(void *))
{
if (eventPtr->proc == ThreadEventProc) {
Tcl_Free(((ThreadEvent *) eventPtr)->script);
return 1;
}
/*
* If it was NULL, we were in the middle of servicing the event and it
* should be removed
*/
return (eventPtr->proc == NULL);
}
/*
*------------------------------------------------------------------------
*
* ThreadExitProc --
*
* 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.
*
*------------------------------------------------------------------------
*/
static void
ThreadExitProc(
void *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 (self == errorThreadId) {
if (errorProcString) { /* Extra safety */
Tcl_Free(errorProcString);
errorProcString = NULL;
}
errorThreadId = 0;
}
if (threadEvalScript) {
Tcl_Free(threadEvalScript);
threadEvalScript = NULL;
}
Tcl_DeleteEvents((Tcl_EventDeleteProc *) ThreadDeleteEvent, NULL);
for (resultPtr = resultList ; resultPtr ; resultPtr = nextPtr) {
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.
*/
if (resultPtr->prevPtr) {
resultPtr->prevPtr->nextPtr = resultPtr->nextPtr;
} else {
resultList = resultPtr->nextPtr;
}
if (resultPtr->nextPtr) {
resultPtr->nextPtr->prevPtr = resultPtr->prevPtr;
}
resultPtr->nextPtr = resultPtr->prevPtr = 0;
resultPtr->eventPtr->resultPtr = NULL;
Tcl_Free(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.
*/
const char *msg = "target thread died";
resultPtr->result = (char *)Tcl_Alloc(strlen(msg) + 1);
strcpy(resultPtr->result, msg);
resultPtr->code = TCL_ERROR;
Tcl_ConditionNotify(&resultPtr->done);
}
}
Tcl_MutexUnlock(&threadMutex);
}
#endif /* TCL_THREADS */
/*
*----------------------------------------------------------------------
*
* TestMutexCmd --
*
* This procedure is invoked to process the "testmutex" Tcl command.
*
* testmutex counter ?numthreads? ?numrecursions? ?numiterations?
* testmutex conditionvariable ?numthreads? ?numrecursions? ?numiterations?
*
* Results:
* A standard Tcl result.
*
*----------------------------------------------------------------------
*/
static int
TestMutexCmd(
TCL_UNUSED(void *),
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[]) /* Argument objects. */
{
static const char *const mutexOptions[] = {
"lock", "condition", NULL
};
enum options {
LOCK, CONDITION
} option;
MutexSharedContext context = {
2, /* numThreads */
1, /* numRecursions */
1000000, /* numIterations */
1, /* yield */
{0}, /* u.counter */
};
if (objc < 2 || objc > 6) {
Tcl_WrongNumArgs(interp, 1, objv,
"option ?numthreads? ?numrecursions? ?numiterations? ?yield?");
return TCL_ERROR;
}
if (Tcl_GetIndexFromObj(interp, objv[1], mutexOptions, "option", 0,
&option) != TCL_OK) {
return TCL_ERROR;
}
if (objc > 2) {
if (Tcl_GetIntFromObj(interp, objv[2],
&context.numThreads) != TCL_OK) {
return TCL_ERROR;
}
if (objc > 3) {
if (Tcl_GetIntFromObj(interp, objv[3],
&context.numRecursions) != TCL_OK) {
return TCL_ERROR;
}
if (objc > 4) {
if (Tcl_GetIntFromObj(interp, objv[4],
&context.numIterations) != TCL_OK) {
return TCL_ERROR;
}
if (objc > 5) {
if (Tcl_GetIntFromObj(
interp, objv[5], &context.yield) != TCL_OK) {
return TCL_ERROR;
}
}
}
}
}
if (context.numIterations <= 0 || context.numRecursions <= 0 ||
context.numThreads <= 0) {
Tcl_SetResult(interp,
"Thread, recursion and iteration counts must not be 0.",
TCL_STATIC);
}
int result = TCL_OK;
switch (option) {
case LOCK:
result = TestMutexLock(interp, &context);
break;
case CONDITION:
result = TestConditionVariable(interp, &context);
break;
}
return result;
}
/*
*------------------------------------------------------------------------
*
* TestMutexLock --
*
* Implements the "testmutex lock" command to test Tcl_MutexLock.
*
* Results:
* A Tcl result code.
*
* Side effects:
* Stores a result in the interpreter.
*
*------------------------------------------------------------------------
*/
static int
TestMutexLock(
Tcl_Interp *interp,
MutexSharedContext *contextPtr)
{
MutexThreadContext *threadContextsPtr =
(MutexThreadContext *)Tcl_Alloc(
sizeof(*threadContextsPtr) * contextPtr->numThreads);
contextPtr->u.counter = 0;
mutexThreadCount = 0;
for (int i = 0; i < contextPtr->numThreads; i++) {
threadContextsPtr[i].sharedContextPtr = contextPtr;
threadContextsPtr[i].numOperations = 0; /* Init though not used */
if (Tcl_CreateThread(&threadContextsPtr[i].threadId,
CounterThreadProc,
&threadContextsPtr[i],
TCL_THREAD_STACK_DEFAULT,
TCL_THREAD_JOINABLE) != TCL_OK) {
Tcl_Panic("Failed to create %d'th thread\n", i);
}
}
mutexThreadCount = contextPtr->numThreads; /* Will fire off all test threads */
/* Wait for all threads */
for (int i = 0; i < contextPtr->numThreads; i++) {
int threadResult;
Tcl_JoinThread(threadContextsPtr[i].threadId, &threadResult);
}
Tcl_Free(threadContextsPtr);
Tcl_SetObjResult(interp, Tcl_NewWideUIntObj(contextPtr->u.counter));
return TCL_OK;
}
/*
*------------------------------------------------------------------------
*
* CounterThreadProc --
*
* Increments a shared counter a specified number of times and exits
* the thread.
*
* Results:
* None.
*
* Side effects:
* None.
*
*------------------------------------------------------------------------
*/
static Tcl_ThreadCreateType
CounterThreadProc(void *clientData)
{
MutexThreadContext *threadContextPtr = (MutexThreadContext *)clientData;
MutexSharedContext *contextPtr = threadContextPtr->sharedContextPtr;
/* Spin wait until given the run signal */
while (mutexThreadCount < contextPtr->numThreads) {
YieldToOtherThreads();
}
for (int i = 0; i < contextPtr->numIterations; i++) {
for (int j = 0; j < contextPtr->numRecursions; ++j) {
Tcl_MutexLock(&testContextMutex);
}
Tcl_WideUInt temp = contextPtr->u.counter;
if (contextPtr->yield) {
/* Some delay. No one else is supposed to modify the counter */
YieldToOtherThreads();
}
contextPtr->u.counter = temp + 1; /* Increment original value read */
for (int j = 0; j < contextPtr->numRecursions; ++j) {
Tcl_MutexUnlock(&testContextMutex);
}
}
Tcl_ExitThread(0);
TCL_THREAD_CREATE_RETURN;
}
/*
*------------------------------------------------------------------------
*
* TestConditionVariable --
*
* Implements the "testmutex condition" command to test Tcl_Condition*.
* The test emulates a producer-consumer scenario.
*
* Results:
* A Tcl result code.
*
* Side effects:
* Stores a result in the interpreter.
*
*------------------------------------------------------------------------
*/
static int
TestConditionVariable(
Tcl_Interp *interp,
MutexSharedContext *contextPtr)
{
Tcl_SetResult(interp, "Not implemented", TCL_STATIC);
if (contextPtr->numThreads < 2) {
Tcl_SetResult(interp, "Need at least 2 threads.", TCL_STATIC);
return TCL_ERROR;
}
int numProducers = contextPtr->numThreads / 2;
int numConsumers = contextPtr->numThreads - numProducers;
contextPtr->u.queue.canDequeue = NULL;
contextPtr->u.queue.canEnqueue = NULL;
/*
* available tracks how many elements in the virtual queue
* capacity is max length of virtual queue.
*/
contextPtr->u.queue.totalEnqueued = 0;
contextPtr->u.queue.totalDequeued = 0;
contextPtr->u.queue.available = 0;
contextPtr->u.queue.capacity = 3; /* Arbitrary for now */
MutexThreadContext *consumerContextsPtr = (MutexThreadContext *)Tcl_Alloc(
sizeof(*consumerContextsPtr) * numConsumers);
MutexThreadContext *producerContextsPtr = (MutexThreadContext *)Tcl_Alloc(
sizeof(*producerContextsPtr) * numProducers);
mutexThreadCount = 0;
for (int i = 0; i < numConsumers; i++) {
consumerContextsPtr[i].sharedContextPtr = contextPtr;
consumerContextsPtr[i].numOperations = 0;
consumerContextsPtr[i].timeouts = 0;
if (Tcl_CreateThread(&consumerContextsPtr[i].threadId,
ConsumerThreadProc, &consumerContextsPtr[i],
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
Tcl_Panic("Failed to create %d'th thread\n", (int) i);
}
}
for (int i = 0; i < numProducers; i++) {
producerContextsPtr[i].sharedContextPtr = contextPtr;
producerContextsPtr[i].numOperations = 0;
producerContextsPtr[i].timeouts = 0;
if (Tcl_CreateThread(&producerContextsPtr[i].threadId,
ProducerThreadProc, &producerContextsPtr[i],
TCL_THREAD_STACK_DEFAULT, TCL_THREAD_JOINABLE) != TCL_OK) {
Tcl_Panic("Failed to create %d'th thread\n", (int) i);
}
}
mutexThreadCount = contextPtr->numThreads; /* Will trigger all threads */
/* Producer total, thread, timeouts, Consumer total, thread, timeouts */
Tcl_Obj *results[6];
results[1] = Tcl_NewListObj(numProducers, NULL);
results[4] = Tcl_NewListObj(numConsumers, NULL);
Tcl_WideUInt producerTimeouts = 0;
Tcl_WideUInt producerOperations = 0;
Tcl_WideUInt consumerTimeouts = 0;
Tcl_WideUInt consumerOperations = 0;
for (int i = 0; i < numProducers; i++) {
int threadResult;
Tcl_JoinThread(producerContextsPtr[i].threadId, &threadResult);
producerOperations += producerContextsPtr[i].numOperations;
Tcl_ListObjAppendElement(NULL, results[1],
Tcl_NewWideUIntObj(producerContextsPtr[i].numOperations));
producerTimeouts += producerContextsPtr[i].timeouts;
}
for (int i = 0; i < numConsumers; i++) {
int threadResult;
Tcl_JoinThread(consumerContextsPtr[i].threadId, &threadResult);
consumerOperations += consumerContextsPtr[i].numOperations;
Tcl_ListObjAppendElement(NULL, results[4],
Tcl_NewWideUIntObj(consumerContextsPtr[i].numOperations));
consumerTimeouts += consumerContextsPtr[i].timeouts;
}
results[0] = Tcl_NewWideUIntObj(producerOperations);
results[2] = Tcl_NewWideUIntObj(producerTimeouts);
results[3] = Tcl_NewWideUIntObj(consumerOperations);
results[5] = Tcl_NewWideUIntObj(consumerTimeouts);
Tcl_SetObjResult(interp, Tcl_NewListObj(6, results));
Tcl_Free(producerContextsPtr);
Tcl_Free(consumerContextsPtr);
return TCL_OK;
}
/*
*------------------------------------------------------------------------
*
* ProducerThreadProc --
*
* Acts as a "producer" that enqueues to the virtual resource queue.
*
* Results:
* None.
*
* Side effects:
* None.
*
*------------------------------------------------------------------------
*/
static Tcl_ThreadCreateType
ProducerThreadProc(void *clientData)
{
MutexThreadContext *threadContextPtr = (MutexThreadContext *)clientData;
MutexSharedContext *contextPtr = threadContextPtr->sharedContextPtr;
/* Limit on total number of operations across all threads */
Tcl_WideUInt limit;
limit = contextPtr->numThreads * (Tcl_WideUInt) contextPtr->numIterations;
/* Spin wait until given the run signal */
while (mutexThreadCount < contextPtr->numThreads) {
YieldToOtherThreads();
}
LockTestContext(contextPtr->numRecursions);
while (contextPtr->u.queue.totalEnqueued < limit) {
if (contextPtr->u.queue.available < contextPtr->u.queue.capacity) {
contextPtr->u.queue.available += 1; /* Enqueue operation */
contextPtr->u.queue.totalEnqueued += 1;
threadContextPtr->numOperations += 1;
Tcl_ConditionNotify(&contextPtr->u.queue.canDequeue);
}
Tcl_Time before, after;
Tcl_Time timeout = {CONDITION_TIMEOUT_SECS, 0};
Tcl_GetTime(&before);
Tcl_ConditionWait(
&contextPtr->u.queue.canEnqueue, &testContextMutex, &timeout);
Tcl_GetTime(&after);
if ((1000000 * (after.sec - before.sec) + (after.usec - before.usec))
>= 1000000 * CONDITION_TIMEOUT_SECS) {
threadContextPtr->timeouts += 1;
}
}
UnlockTestContext(contextPtr->numRecursions);
Tcl_ExitThread(0);
TCL_THREAD_CREATE_RETURN;
}
/*
*------------------------------------------------------------------------
*
* ConsumerThreadProc --
*
* Acts as a "consumer" that dequeues from the virtual resource queue.
*
* Results:
* None.
*
* Side effects:
* None.
*
*------------------------------------------------------------------------
*/
static Tcl_ThreadCreateType
ConsumerThreadProc(void *clientData)
{
MutexThreadContext *threadContextPtr = (MutexThreadContext *)clientData;
MutexSharedContext *contextPtr = threadContextPtr->sharedContextPtr;
/* Limit on total number of operations across all threads */
Tcl_WideUInt limit;
limit = contextPtr->numThreads * (Tcl_WideUInt) contextPtr->numIterations;
/* Spin wait until given the run signal */
while (mutexThreadCount < contextPtr->numThreads) {
YieldToOtherThreads();
}
LockTestContext(contextPtr->numRecursions);
while (contextPtr->u.queue.totalDequeued < limit) {
if (contextPtr->u.queue.available > 0) {
contextPtr->u.queue.available -= 1; /* Enqueue operation */
contextPtr->u.queue.totalDequeued += 1;
threadContextPtr->numOperations += 1;
Tcl_ConditionNotify(&contextPtr->u.queue.canEnqueue);
}
if (contextPtr->u.queue.totalDequeued == limit) {
break;
}
Tcl_Time before, after;
Tcl_Time timeout = {CONDITION_TIMEOUT_SECS, 0};
Tcl_GetTime(&before);
Tcl_ConditionWait(
&contextPtr->u.queue.canDequeue, &testContextMutex, &timeout);
Tcl_GetTime(&after);
if ((1000000 * (after.sec - before.sec) + (after.usec - before.usec))
>= 1000000 * CONDITION_TIMEOUT_SECS) {
threadContextPtr->timeouts += 1;
}
}
UnlockTestContext(contextPtr->numRecursions);
Tcl_ExitThread(0);
TCL_THREAD_CREATE_RETURN;
}
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/