static int
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;
if (interp == NULL) {
code = TCL_ERROR;
result = "no target interp!";
errorCode = "THREAD";
errorInfo = "";
} else {
Tcl_Preserve((ClientData) interp);
Tcl_ResetResult(interp);
Tcl_CreateThreadExitHandler(ThreadFreeProc,
(ClientData) threadEventPtr->script);
code = Tcl_GlobalEval(interp, 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);
} else {
errorCode = errorInfo = NULL;
}
result = Tcl_GetStringResult(interp);
}
ckfree(threadEventPtr->script);
if (resultPtr) {
Tcl_MutexLock(&threadMutex);
resultPtr->code = code;
resultPtr->result = ckalloc(strlen(result) + 1);
strcpy(resultPtr->result, result);
if (errorCode != NULL) {
resultPtr->errorCode = ckalloc(strlen(errorCode) + 1);
strcpy(resultPtr->errorCode, errorCode);
}
if (errorInfo != NULL) {
resultPtr->errorInfo = ckalloc(strlen(errorInfo) + 1);
strcpy(resultPtr->errorInfo, errorInfo);
}
Tcl_ConditionNotify(&resultPtr->done);
Tcl_MutexUnlock(&threadMutex);
}
if (interp != NULL) {
Tcl_Release((ClientData) interp);
}
return 1;
}
static
void
WakeManagerThread (void)
{
#ifdef TCL_THREADS
condReady = 1;
Tcl_ConditionNotify(&spointsCV);
#else
Tcl_AsyncMark(activator);
#endif
}
/* ARGSUSED */
static void
ThreadExitProc(
ClientData clientData)
{
char *threadEvalScript = (char *) clientData;
ThreadEventResult *resultPtr, *nextPtr;
Tcl_ThreadId self = Tcl_GetCurrentThread();
Tcl_MutexLock(&threadMutex);
if (threadEvalScript) {
ckfree((char *) 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;
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.
*/
char *msg = "target thread died";
resultPtr->result = ckalloc(strlen(msg)+1);
strcpy(resultPtr->result, msg);
resultPtr->code = TCL_ERROR;
Tcl_ConditionNotify(&resultPtr->done);
}
}
Tcl_MutexUnlock(&threadMutex);
}
static
void
ShutdownManagerThread (void)
{
/* Request the manager thread to terminate */
shutdownRequested = 1;
condReady = 1;
Tcl_ConditionNotify(&spointsCV);
/* Wait for the manager thread to report back it's finished.
* Note that Tcl_ConditionWait unlocks spointsLock
* before starting to wait on spointsCV
* and locks it again before returning */
threadReady = 0;
while (threadReady == 0) {
Tcl_ConditionWait(&spointsCV, &spointsLock, NULL);
}
}
Tcl_ThreadCreateType
NewTestThread(
ClientData 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);
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
*/
threadEvalScript = ckalloc(strlen(ctrlPtr->script)+1);
strcpy(threadEvalScript, ctrlPtr->script);
Tcl_CreateThreadExitHandler(ThreadExitProc, (ClientData) threadEvalScript);
/*
* Notify the parent we are alive.
*/
Tcl_ConditionNotify(&ctrlPtr->condWait);
Tcl_MutexUnlock(&threadMutex);
/*
* Run the script.
*/
Tcl_Preserve((ClientData) tsdPtr->interp);
result = Tcl_Eval(tsdPtr->interp, threadEvalScript);
if (result != TCL_OK) {
ThreadErrorProc(tsdPtr->interp);
}
/*
* Clean up.
*/
ListRemove(tsdPtr);
Tcl_Release((ClientData) tsdPtr->interp);
Tcl_DeleteInterp(tsdPtr->interp);
Tcl_ExitThread(result);
TCL_THREAD_CREATE_RETURN;
}
static
void
ManagerThreadProc (
ClientData clientData
)
{
BlockAllSignals();
Tcl_MutexLock(&spointsLock);
/* Notify creator thread we're ready */
threadReady = 1;
Tcl_ConditionNotify(&spointsCV);
while (1) {
Queue eventQueue;
SignalMapSearch iterator;
SyncPoint *spointPtr;
while (condReady == 0) {
Tcl_ConditionWait(&spointsCV, &spointsLock, NULL);
}
condReady = 0;
if (shutdownRequested) {
break;
}
InitEventList(&eventQueue);
HarvestDanglingSyncpoints(&danglingSpoints, &eventQueue);
spointPtr = FirstSigMapEntry(&syncpoints, &iterator);
while (spointPtr != NULL) {
HarvestSyncpoint(spointPtr, &eventQueue);
spointPtr = NextSigMapEntry(&iterator);
}
Tcl_MutexUnlock(&spointsLock);
{
SignalEvent *evPtr;
Tcl_ThreadId lastId;
evPtr = QueuePop(&eventQueue);
lastId = evPtr->threadId;
do {
SignalEvent *nextEvPtr;
Tcl_ThreadId threadId;
nextEvPtr = QueuePop(&eventQueue);
threadId = evPtr->threadId;
Tcl_ThreadQueueEvent(threadId,
(Tcl_Event*) evPtr, TCL_QUEUE_TAIL);
if (threadId != lastId) {
Tcl_ThreadAlert(lastId);
}
printf("Sent %d to %x\n",
evPtr->signum, evPtr->threadId);
evPtr = nextEvPtr;
lastId = threadId;
} while (evPtr != NULL);
Tcl_ThreadAlert(lastId);
}
Tcl_MutexLock(&spointsLock);
}
/* Notify creator thread we're finished.
* Note that the spointsLock is held at this point. */
threadReady = 1;
Tcl_ConditionNotify(&spointsCV);
Tcl_MutexUnlock(&spointsLock);
}