/* * threadPoolCmd.c -- * * This file implements the Tcl thread pools. * * Copyright (c) 2002 by Zoran Vasiljevic. * * See the file "license.terms" for information on usage and redistribution * of this file, and for a DISCLAIMER OF ALL WARRANTIES. * * RCS: @(#) $Id: threadPoolCmd.c,v 1.43 2010/03/31 08:50:24 vasiljevic Exp $ * ---------------------------------------------------------------------------- */ #include "tclThread.h" /* * Structure to maintain idle poster threads */ typedef struct TpoolWaiter { Tcl_ThreadId threadId; /* Thread id of the current thread */ struct TpoolWaiter *nextPtr; /* Next structure in the list */ struct TpoolWaiter *prevPtr; /* Previous structure in the list */ } TpoolWaiter; /* * Structure describing an instance of a thread pool. */ typedef struct ThreadPool { unsigned int jobId; /* Job counter */ int idleTime; /* Time in secs a worker thread idles */ int tearDown; /* Set to 1 to tear down the pool */ int suspend; /* Set to 1 to suspend pool processing */ char *initScript; /* Script to initialize worker thread */ char *exitScript; /* Script to cleanup the worker */ int minWorkers; /* Minimum number or worker threads */ int maxWorkers; /* Maximum number of worker threads */ int numWorkers; /* Current number of worker threads */ int idleWorkers; /* Number of idle workers */ int refCount; /* Reference counter for reserve/release */ Tcl_Mutex mutex; /* Pool mutex */ Tcl_Condition cond; /* Pool condition variable */ Tcl_HashTable jobsDone; /* Stores processed job results */ struct TpoolResult *workTail; /* Tail of the list with jobs pending*/ struct TpoolResult *workHead; /* Head of the list with jobs pending*/ struct TpoolWaiter *waitTail; /* Tail of the thread waiters list */ struct TpoolWaiter *waitHead; /* Head of the thread waiters list */ struct ThreadPool *nextPtr; /* Next structure in the threadpool list */ struct ThreadPool *prevPtr; /* Previous structure in threadpool list */ } ThreadPool; #define TPOOL_HNDLPREFIX "tpool" /* Prefix to generate Tcl pool handles */ #define TPOOL_MINWORKERS 0 /* Default minimum # of worker threads */ #define TPOOL_MAXWORKERS 4 /* Default maximum # of worker threads */ #define TPOOL_IDLETIMER 0 /* Default worker thread idle timer */ /* * Structure for passing evaluation results */ typedef struct TpoolResult { int detached; /* Result is to be ignored */ unsigned int jobId; /* The job id of the current job */ char *script; /* Script to evaluate in worker thread */ int scriptLen; /* Length of the script */ int retcode; /* Tcl return code of the current job */ char *result; /* Tcl result of the current job */ char *errorCode; /* On error: content of the errorCode */ char *errorInfo; /* On error: content of the errorInfo */ Tcl_ThreadId threadId; /* Originating thread id */ ThreadPool *tpoolPtr; /* Current thread pool */ struct TpoolResult *nextPtr; struct TpoolResult *prevPtr; } TpoolResult; /* * Private structure for each worker/poster thread. */ typedef struct ThreadSpecificData { int stop; /* Set stop event; exit from event loop */ TpoolWaiter *waitPtr; /* Threads private idle structure */ } ThreadSpecificData; static Tcl_ThreadDataKey dataKey; /* * This global list maintains thread pools. */ static ThreadPool *tpoolList; static Tcl_Mutex listMutex; static Tcl_Mutex startMutex; /* * Used to represent the empty result. */ static char *threadEmptyResult = (char *)""; /* * Functions implementing Tcl commands */ static Tcl_ObjCmdProc TpoolCreateObjCmd; static Tcl_ObjCmdProc TpoolPostObjCmd; static Tcl_ObjCmdProc TpoolWaitObjCmd; static Tcl_ObjCmdProc TpoolCancelObjCmd; static Tcl_ObjCmdProc TpoolGetObjCmd; static Tcl_ObjCmdProc TpoolReserveObjCmd; static Tcl_ObjCmdProc TpoolReleaseObjCmd; static Tcl_ObjCmdProc TpoolSuspendObjCmd; static Tcl_ObjCmdProc TpoolResumeObjCmd; static Tcl_ObjCmdProc TpoolNamesObjCmd; /* * Miscelaneous functions used within this file */ static int CreateWorker _ANSI_ARGS_((Tcl_Interp *interp, ThreadPool *tpoolPtr)); static Tcl_ThreadCreateType TpoolWorker _ANSI_ARGS_((ClientData clientData)); static int RunStopEvent _ANSI_ARGS_((Tcl_Event *evPtr, int mask)); static void PushWork _ANSI_ARGS_((TpoolResult *rPtr, ThreadPool *tpoolPtr)); static TpoolResult* PopWork _ANSI_ARGS_((ThreadPool *tpoolPtr)); static void PushWaiter _ANSI_ARGS_((ThreadPool *tpoolPtr)); static TpoolWaiter* PopWaiter _ANSI_ARGS_((ThreadPool *tpoolPtr)); static void SignalWaiter _ANSI_ARGS_((ThreadPool *tpoolPtr)); static int TpoolEval _ANSI_ARGS_((Tcl_Interp *interp, char *script, int scriptLen, TpoolResult *rPtr)); static void SetResult _ANSI_ARGS_((Tcl_Interp *interp, TpoolResult *rPtr)); static ThreadPool* GetTpool _ANSI_ARGS_((const char *tpoolName)); static ThreadPool* GetTpoolUnl _ANSI_ARGS_((const char *tpoolName)); static void ThrExitHandler _ANSI_ARGS_((ClientData clientData)); static void AppExitHandler _ANSI_ARGS_((ClientData clientData)); static int TpoolReserve _ANSI_ARGS_((ThreadPool *tpoolPtr)); static int TpoolRelease _ANSI_ARGS_((ThreadPool *tpoolPtr)); static void TpoolSuspend _ANSI_ARGS_((ThreadPool *tpoolPtr)); static void TpoolResume _ANSI_ARGS_((ThreadPool *tpoolPtr)); static void InitWaiter _ANSI_ARGS_((void)); /* *---------------------------------------------------------------------- * * TpoolCreateObjCmd -- * * This procedure is invoked to process the "tpool::create" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolCreateObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { int ii, minw, maxw, idle, len; char buf[64], *exs = NULL, *cmd = NULL; ThreadPool *tpoolPtr; /* * Syntax: tpool::create ?-minworkers count? * ?-maxworkers count? * ?-initcmd script? * ?-exitcmd script? * ?-idletime seconds? */ if (((objc-1) % 2)) { goto usage; } minw = TPOOL_MINWORKERS; maxw = TPOOL_MAXWORKERS; idle = TPOOL_IDLETIMER; /* * Parse the optional arguments */ for (ii = 1; ii < objc; ii += 2) { char *opt = Tcl_GetString(objv[ii]); if (OPT_CMP(opt, "-minworkers")) { if (Tcl_GetIntFromObj(interp, objv[ii+1], &minw) != TCL_OK) { return TCL_ERROR; } } else if (OPT_CMP(opt, "-maxworkers")) { if (Tcl_GetIntFromObj(interp, objv[ii+1], &maxw) != TCL_OK) { return TCL_ERROR; } } else if (OPT_CMP(opt, "-idletime")) { if (Tcl_GetIntFromObj(interp, objv[ii+1], &idle) != TCL_OK) { return TCL_ERROR; } } else if (OPT_CMP(opt, "-initcmd")) { const char *val = Tcl_GetStringFromObj(objv[ii+1], &len); cmd = strcpy(Tcl_Alloc(len+1), val); } else if (OPT_CMP(opt, "-exitcmd")) { const char *val = Tcl_GetStringFromObj(objv[ii+1], &len); exs = strcpy(Tcl_Alloc(len+1), val); } else { goto usage; } } /* * Do some consistency checking */ if (minw < 0) { minw = 0; } if (maxw < 0) { maxw = TPOOL_MAXWORKERS; } if (minw > maxw) { maxw = minw; } /* * Allocate and initialize thread pool structure */ tpoolPtr = (ThreadPool*)Tcl_Alloc(sizeof(ThreadPool)); memset(tpoolPtr, 0, sizeof(ThreadPool)); tpoolPtr->minWorkers = minw; tpoolPtr->maxWorkers = maxw; tpoolPtr->idleTime = idle; tpoolPtr->initScript = cmd; tpoolPtr->exitScript = exs; Tcl_InitHashTable(&tpoolPtr->jobsDone, TCL_ONE_WORD_KEYS); Tcl_MutexLock(&listMutex); SpliceIn(tpoolPtr, tpoolList); Tcl_MutexUnlock(&listMutex); /* * Start the required number of worker threads. * On failure to start any of them, tear-down * partially initialized pool. */ Tcl_MutexLock(&tpoolPtr->mutex); for (ii = 0; ii < tpoolPtr->minWorkers; ii++) { if (CreateWorker(interp, tpoolPtr) != TCL_OK) { Tcl_MutexUnlock(&tpoolPtr->mutex); Tcl_MutexLock(&listMutex); TpoolRelease(tpoolPtr); Tcl_MutexUnlock(&listMutex); return TCL_ERROR; } } Tcl_MutexUnlock(&tpoolPtr->mutex); sprintf(buf, "%s%p", TPOOL_HNDLPREFIX, tpoolPtr); Tcl_SetObjResult(interp, Tcl_NewStringObj(buf, -1)); return TCL_OK; usage: Tcl_WrongNumArgs(interp, 1, objv, "?-minworkers count? ?-maxworkers count? " "?-initcmd script? ?-exitcmd script? " "?-idletime seconds?"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TpoolPostObjCmd -- * * This procedure is invoked to process the "tpool::post" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolPostObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { unsigned int jobId = 0; int ii, detached = 0, nowait = 0, len; const char *tpoolName, *script; TpoolResult *rPtr; ThreadPool *tpoolPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Syntax: tpool::post ?-detached? ?-nowait? tpoolId script */ if (objc < 3 || objc > 5) { goto usage; } for (ii = 1; ii < objc; ii++) { char *opt = Tcl_GetString(objv[ii]); if (*opt != '-') { break; } else if (OPT_CMP(opt, "-detached")) { detached = 1; } else if (OPT_CMP(opt, "-nowait")) { nowait = 1; } else { goto usage; } } tpoolName = Tcl_GetString(objv[ii]); script = Tcl_GetStringFromObj(objv[ii+1], &len); tpoolPtr = GetTpool(tpoolName); if (tpoolPtr == NULL) { Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } /* * Initialize per-thread private data for this caller */ InitWaiter(); /* * See if any worker available to run the job. */ Tcl_MutexLock(&tpoolPtr->mutex); if (nowait && tpoolPtr->numWorkers == 0) { /* * Do not wait for an idle thread but assure * there is at least one worker started. */ PushWaiter(tpoolPtr); if (CreateWorker(interp, tpoolPtr) != TCL_OK) { Tcl_MutexUnlock(&tpoolPtr->mutex); return TCL_ERROR; } /* Wait for worker to start and service the event loop */ Tcl_MutexUnlock(&tpoolPtr->mutex); tsdPtr->stop = -1; while(tsdPtr->stop == -1) { Tcl_DoOneEvent(TCL_ALL_EVENTS); } Tcl_MutexLock(&tpoolPtr->mutex); } else { /* * If there are no idle worker threads, start some new * unless we are already running max number of workers. * In that case wait for the next one to become idle. */ while (tpoolPtr->idleWorkers == 0) { PushWaiter(tpoolPtr); if (tpoolPtr->numWorkers < tpoolPtr->maxWorkers) { /* No more free workers; start new one */ if (CreateWorker(interp, tpoolPtr) != TCL_OK) { Tcl_MutexUnlock(&tpoolPtr->mutex); return TCL_ERROR; } } /* Wait for any idle worker and service the event loop */ Tcl_MutexUnlock(&tpoolPtr->mutex); tsdPtr->stop = -1; while(tsdPtr->stop == -1) { Tcl_DoOneEvent(TCL_ALL_EVENTS); } Tcl_MutexLock(&tpoolPtr->mutex); } } /* * Create new job ticket and put it on the list. */ rPtr = (TpoolResult*)Tcl_Alloc(sizeof(TpoolResult)); memset(rPtr, 0, sizeof(TpoolResult)); if (detached == 0) { jobId = ++tpoolPtr->jobId; rPtr->jobId = jobId; } rPtr->script = strcpy(Tcl_Alloc(len+1), script); rPtr->scriptLen = len; rPtr->detached = detached; rPtr->threadId = Tcl_GetCurrentThread(); PushWork(rPtr, tpoolPtr); Tcl_ConditionNotify(&tpoolPtr->cond); Tcl_MutexUnlock(&tpoolPtr->mutex); if (detached == 0) { Tcl_SetObjResult(interp, Tcl_NewIntObj(jobId)); } return TCL_OK; usage: Tcl_WrongNumArgs(interp, 1, objv, "?-detached? ?-nowait? tpoolId script"); return TCL_ERROR; } /* *---------------------------------------------------------------------- * * TpoolWaitObjCmd -- * * This procedure is invoked to process the "tpool::wait" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolWaitObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { int ii, done, wObjc; unsigned int jobId; char *tpoolName, *listVar = NULL; Tcl_Obj *waitList, *doneList, **wObjv; ThreadPool *tpoolPtr; TpoolResult *rPtr; Tcl_HashEntry *hPtr; ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); /* * Syntax: tpool::wait tpoolId jobIdList ?listVar? */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId jobIdList ?listVar"); return TCL_ERROR; } if (objc == 4) { listVar = Tcl_GetString(objv[3]); } if (Tcl_ListObjGetElements(interp, objv[2], &wObjc, &wObjv) != TCL_OK) { return TCL_ERROR; } tpoolName = Tcl_GetString(objv[1]); tpoolPtr = GetTpool(tpoolName); if (tpoolPtr == NULL) { Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } InitWaiter(); done = 0; /* Number of elements in the done list */ doneList = Tcl_NewListObj(0, NULL); Tcl_MutexLock(&tpoolPtr->mutex); while (1) { waitList = Tcl_NewListObj(0, NULL); for (ii = 0; ii < wObjc; ii++) { if (Tcl_GetIntFromObj(interp, wObjv[ii], (int *)&jobId) != TCL_OK) { Tcl_MutexUnlock(&tpoolPtr->mutex); return TCL_ERROR; } hPtr = Tcl_FindHashEntry(&tpoolPtr->jobsDone, (char*)jobId); if (hPtr) { rPtr = (TpoolResult*)Tcl_GetHashValue(hPtr); } else { for (rPtr = tpoolPtr->workHead; rPtr; rPtr = rPtr->nextPtr) { if (rPtr->jobId == jobId) { break; } } if (rPtr == NULL) { continue; /* Bogus job id; ignore */ } } if (rPtr->detached) { continue; /* A detached job */ } if (rPtr->result) { done++; /* Job has been processed */ Tcl_ListObjAppendElement(interp, doneList, wObjv[ii]); } else if (listVar) { Tcl_ListObjAppendElement(interp, waitList, wObjv[ii]); } } if (done) { break; } /* * None of the jobs done, wait for completion * of the next job and try again. */ Tcl_DecrRefCount(waitList); PushWaiter(tpoolPtr); Tcl_MutexUnlock(&tpoolPtr->mutex); tsdPtr->stop = -1; while (tsdPtr->stop == -1) { Tcl_DoOneEvent(TCL_ALL_EVENTS); } Tcl_MutexLock(&tpoolPtr->mutex); } Tcl_MutexUnlock(&tpoolPtr->mutex); if (listVar) { Tcl_SetVar2Ex(interp, listVar, NULL, waitList, 0); } Tcl_SetObjResult(interp, doneList); return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolCancelObjCmd -- * * This procedure is invoked to process the "tpool::cancel" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolCancelObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { int ii, wObjc, jobId; char *tpoolName, *listVar = NULL; Tcl_Obj *doneList, *waitList, **wObjv; ThreadPool *tpoolPtr; TpoolResult *rPtr; /* * Syntax: tpool::wait tpoolId jobIdList ?listVar? */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId jobIdList ?listVar"); return TCL_ERROR; } if (objc == 4) { listVar = Tcl_GetString(objv[3]); } if (Tcl_ListObjGetElements(interp, objv[2], &wObjc, &wObjv) != TCL_OK) { return TCL_ERROR; } tpoolName = Tcl_GetString(objv[1]); tpoolPtr = GetTpool(tpoolName); if (tpoolPtr == NULL) { Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } InitWaiter(); doneList = Tcl_NewListObj(0, NULL); waitList = Tcl_NewListObj(0, NULL); Tcl_MutexLock(&tpoolPtr->mutex); for (ii = 0; ii < wObjc; ii++) { if (Tcl_GetIntFromObj(interp, wObjv[ii], &jobId) != TCL_OK) { return TCL_ERROR; } for (rPtr = tpoolPtr->workHead; rPtr; rPtr = rPtr->nextPtr) { if (rPtr->jobId == (unsigned int)jobId) { if (rPtr->prevPtr != NULL) { rPtr->prevPtr->nextPtr = rPtr->nextPtr; } else { tpoolPtr->workHead = rPtr->nextPtr; } if (rPtr->nextPtr != NULL) { rPtr->nextPtr->prevPtr = rPtr->prevPtr; } else { tpoolPtr->workTail = rPtr->prevPtr; } SetResult(NULL, rPtr); /* Just to free the result */ Tcl_Free(rPtr->script); Tcl_Free((char*)rPtr); Tcl_ListObjAppendElement(interp, doneList, wObjv[ii]); break; } } if (rPtr == NULL && listVar) { Tcl_ListObjAppendElement(interp, waitList, wObjv[ii]); } } Tcl_MutexUnlock(&tpoolPtr->mutex); if (listVar) { Tcl_SetVar2Ex(interp, listVar, NULL, waitList, 0); } Tcl_SetObjResult(interp, doneList); return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolGetObjCmd -- * * This procedure is invoked to process the "tpool::get" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolGetObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { int ret, jobId; char *tpoolName, *resVar = NULL; ThreadPool *tpoolPtr; TpoolResult *rPtr; Tcl_HashEntry *hPtr; /* * Syntax: tpool::get tpoolId jobId ?result? */ if (objc < 3 || objc > 4) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId jobId ?result?"); return TCL_ERROR; } if (Tcl_GetIntFromObj(interp, objv[2], &jobId) != TCL_OK) { return TCL_ERROR; } if (objc == 4) { resVar = Tcl_GetString(objv[3]); } /* * Locate the threadpool */ tpoolName = Tcl_GetString(objv[1]); tpoolPtr = GetTpool(tpoolName); if (tpoolPtr == NULL) { Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } /* * Locate the job in question. It is an error to * do a "get" on bogus job handle or on the job * which did not complete yet. */ Tcl_MutexLock(&tpoolPtr->mutex); hPtr = Tcl_FindHashEntry(&tpoolPtr->jobsDone, (char*)jobId); if (hPtr == NULL) { Tcl_MutexUnlock(&tpoolPtr->mutex); Tcl_AppendResult(interp, "no such job", NULL); return TCL_ERROR; } rPtr = (TpoolResult*)Tcl_GetHashValue(hPtr); if (rPtr->result == NULL) { Tcl_MutexUnlock(&tpoolPtr->mutex); Tcl_AppendResult(interp, "job not completed", NULL); return TCL_ERROR; } Tcl_DeleteHashEntry(hPtr); Tcl_MutexUnlock(&tpoolPtr->mutex); ret = rPtr->retcode; SetResult(interp, rPtr); Tcl_Free((char*)rPtr); if (resVar) { Tcl_SetVar2Ex(interp, resVar, NULL, Tcl_GetObjResult(interp), 0); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); ret = TCL_OK; } return ret; } /* *---------------------------------------------------------------------- * * TpoolReserveObjCmd -- * * This procedure is invoked to process the "tpool::preserve" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolReserveObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { int ret; char *tpoolName; ThreadPool *tpoolPtr; /* * Syntax: tpool::preserve tpoolId */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); return TCL_ERROR; } tpoolName = Tcl_GetString(objv[1]); Tcl_MutexLock(&listMutex); tpoolPtr = GetTpoolUnl(tpoolName); if (tpoolPtr == NULL) { Tcl_MutexUnlock(&listMutex); Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } ret = TpoolReserve(tpoolPtr); Tcl_MutexUnlock(&listMutex); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolReleaseObjCmd -- * * This procedure is invoked to process the "tpool::release" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolReleaseObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { int ret; char *tpoolName; ThreadPool *tpoolPtr; /* * Syntax: tpool::release tpoolId */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); return TCL_ERROR; } tpoolName = Tcl_GetString(objv[1]); Tcl_MutexLock(&listMutex); tpoolPtr = GetTpoolUnl(tpoolName); if (tpoolPtr == NULL) { Tcl_MutexUnlock(&listMutex); Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } ret = TpoolRelease(tpoolPtr); Tcl_MutexUnlock(&listMutex); Tcl_SetObjResult(interp, Tcl_NewIntObj(ret)); return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolSuspendObjCmd -- * * This procedure is invoked to process the "tpool::suspend" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolSuspendObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { char *tpoolName; ThreadPool *tpoolPtr; /* * Syntax: tpool::suspend tpoolId */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); return TCL_ERROR; } tpoolName = Tcl_GetString(objv[1]); tpoolPtr = GetTpool(tpoolName); if (tpoolPtr == NULL) { Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } TpoolSuspend(tpoolPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolResumeObjCmd -- * * This procedure is invoked to process the "tpool::resume" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolResumeObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { char *tpoolName; ThreadPool *tpoolPtr; /* * Syntax: tpool::resume tpoolId */ if (objc != 2) { Tcl_WrongNumArgs(interp, 1, objv, "tpoolId"); return TCL_ERROR; } tpoolName = Tcl_GetString(objv[1]); tpoolPtr = GetTpool(tpoolName); if (tpoolPtr == NULL) { Tcl_AppendResult(interp, "can not find threadpool \"", tpoolName, "\"", NULL); return TCL_ERROR; } TpoolResume(tpoolPtr); return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolNamesObjCmd -- * * This procedure is invoked to process the "tpool::names" Tcl * command. See the user documentation for details on what it does. * * Results: * A standard Tcl result. * * Side effects: * None. * *---------------------------------------------------------------------- */ static int TpoolNamesObjCmd(dummy, interp, objc, objv) ClientData dummy; /* Not used. */ Tcl_Interp *interp; /* Current interpreter. */ int objc; /* Number of arguments. */ Tcl_Obj *const objv[]; /* Argument objects. */ { ThreadPool *tpoolPtr; Tcl_Obj *listObj = Tcl_NewListObj(0, NULL); Tcl_MutexLock(&listMutex); for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolPtr->nextPtr) { char buf[32]; sprintf(buf, "%s%p", TPOOL_HNDLPREFIX, tpoolPtr); Tcl_ListObjAppendElement(interp, listObj, Tcl_NewStringObj(buf,-1)); } Tcl_MutexUnlock(&listMutex); Tcl_SetObjResult(interp, listObj); return TCL_OK; } /* *---------------------------------------------------------------------- * * CreateWorker -- * * Creates new worker thread for the given pool. Assumes the caller * holds the pool mutex. * * Results: * None. * * Side effects: * Informs waiter thread (if any) about the new worker thread. * *---------------------------------------------------------------------- */ static int CreateWorker(interp, tpoolPtr) Tcl_Interp *interp; ThreadPool *tpoolPtr; { Tcl_ThreadId id; TpoolResult result; /* * Initialize the result structure to be * passed to the new thread. This is used * as communication to and from the thread. */ memset(&result, 0, sizeof(TpoolResult)); result.retcode = -1; result.tpoolPtr = tpoolPtr; /* * Create new worker thread here. Wait for the thread to start * because it's using the ThreadResult arg which is on our stack. */ Tcl_MutexLock(&startMutex); if (Tcl_CreateThread(&id, TpoolWorker, (ClientData)&result, TCL_THREAD_STACK_DEFAULT, 0) != TCL_OK) { Tcl_SetResult(interp, "can't create a new thread", TCL_STATIC); Tcl_MutexUnlock(&startMutex); return TCL_ERROR; } while(result.retcode == -1) { Tcl_ConditionWait(&tpoolPtr->cond, &startMutex, NULL); } Tcl_MutexUnlock(&startMutex); /* * Set error-related information if the thread * failed to initialize correctly. */ if (result.retcode == 1) { result.retcode = TCL_ERROR; SetResult(interp, &result); return TCL_ERROR; } return TCL_OK; } /* *---------------------------------------------------------------------- * * TpoolWorker -- * * This is the main function of each of the threads in the pool. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static Tcl_ThreadCreateType TpoolWorker(clientData) ClientData clientData; { TpoolResult *rPtr = (TpoolResult*)clientData; ThreadPool *tpoolPtr = rPtr->tpoolPtr; int tout = 0; Tcl_Interp *interp; Tcl_Time waitTime, *idlePtr; char *errMsg; Tcl_MutexLock(&startMutex); /* * Initialize the Tcl interpreter */ #ifdef NS_AOLSERVER interp = (Tcl_Interp*)Ns_TclAllocateInterp(NULL); rPtr->retcode = 0; #else interp = Tcl_CreateInterp(); if (Tcl_Init(interp) != TCL_OK) { rPtr->retcode = 1; } else if (Thread_Init(interp) != TCL_OK) { rPtr->retcode = 1; } else { rPtr->retcode = 0; } #endif if (rPtr->retcode == 1) { errMsg = (char*)Tcl_GetStringResult(interp); rPtr->result = strcpy(Tcl_Alloc(strlen(errMsg)+1), errMsg); Tcl_ConditionNotify(&tpoolPtr->cond); Tcl_MutexUnlock(&startMutex); goto out; } /* * Initialize the interpreter */ if (tpoolPtr->initScript) { TpoolEval(interp, tpoolPtr->initScript, -1, rPtr); if (rPtr->retcode != TCL_OK) { rPtr->retcode = 1; errMsg = (char*)Tcl_GetStringResult(interp); rPtr->result = strcpy(Tcl_Alloc(strlen(errMsg)+1), errMsg); Tcl_ConditionNotify(&tpoolPtr->cond); Tcl_MutexUnlock(&startMutex); goto out; } } /* * Setup idle timer */ if (tpoolPtr->idleTime == 0) { idlePtr = NULL; } else { waitTime.sec = tpoolPtr->idleTime; waitTime.usec = 0; idlePtr = &waitTime; } /* * Tell caller we've started */ tpoolPtr->numWorkers++; Tcl_ConditionNotify(&tpoolPtr->cond); Tcl_MutexUnlock(&startMutex); /* * Wait for jobs to arrive. Note the handcrafted time test. * Tcl API misses the return value of the Tcl_ConditionWait(). * Hence, we do not know why the call returned. Was it someone * signalled the variable or has the idle timer expired? */ Tcl_MutexLock(&tpoolPtr->mutex); while (!tpoolPtr->tearDown) { SignalWaiter(tpoolPtr); tpoolPtr->idleWorkers++; rPtr = NULL; tout = 0; while (tpoolPtr->suspend || (!tpoolPtr->tearDown && !tout && (rPtr = PopWork(tpoolPtr)) == NULL)) { if (tpoolPtr->suspend && rPtr == NULL) { Tcl_ConditionWait(&tpoolPtr->cond, &tpoolPtr->mutex, NULL); } else if (rPtr == NULL) { Tcl_Time t1, t2; Tcl_GetTime(&t1); Tcl_ConditionWait(&tpoolPtr->cond, &tpoolPtr->mutex, idlePtr); Tcl_GetTime(&t2); if (tpoolPtr->idleTime > 0) { tout = (t2.sec - t1.sec) >= tpoolPtr->idleTime; } } } tpoolPtr->idleWorkers--; if (rPtr == NULL) { if (tpoolPtr->numWorkers > tpoolPtr->minWorkers) { break; /* Enough workers, can safely kill this one */ } else { continue; /* Worker count at min, leave this one alive */ } } else if (tpoolPtr->tearDown) { PushWork(rPtr, tpoolPtr); break; /* Kill worker because pool is going down */ } Tcl_MutexUnlock(&tpoolPtr->mutex); TpoolEval(interp, rPtr->script, rPtr->scriptLen, rPtr); Tcl_MutexLock(&tpoolPtr->mutex); Tcl_Free(rPtr->script); if (!rPtr->detached) { int new; Tcl_SetHashValue(Tcl_CreateHashEntry(&tpoolPtr->jobsDone, (char*)rPtr->jobId, &new), (ClientData)rPtr); } else { Tcl_Free((char*)rPtr); } } /* * Tear down the worker */ if (tpoolPtr->exitScript) { TpoolEval(interp, tpoolPtr->exitScript, -1, NULL); } tpoolPtr->numWorkers--; SignalWaiter(tpoolPtr); Tcl_MutexUnlock(&tpoolPtr->mutex); out: #ifdef NS_AOLSERVER Ns_TclMarkForDelete(interp); Ns_TclDeAllocateInterp(interp); #else Tcl_DeleteInterp(interp); #endif Tcl_ExitThread(0); TCL_THREAD_CREATE_RETURN; } /* *---------------------------------------------------------------------- * * RunStopEvent -- * * Signalizes the waiter thread to stop waiting. * * Results: * 1 (always) * * Side effects: * None. * *---------------------------------------------------------------------- */ static int RunStopEvent(eventPtr, mask) Tcl_Event *eventPtr; int mask; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); tsdPtr->stop = 1; return 1; } /* *---------------------------------------------------------------------- * * PushWork -- * * Adds a worker thread to the end of the workers list. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PushWork(rPtr, tpoolPtr) TpoolResult *rPtr; ThreadPool *tpoolPtr; { SpliceIn(rPtr, tpoolPtr->workHead); if (tpoolPtr->workTail == NULL) { tpoolPtr->workTail = rPtr; } } /* *---------------------------------------------------------------------- * * PopWork -- * * Pops the work ticket from the list * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static TpoolResult * PopWork(tpoolPtr) ThreadPool *tpoolPtr; { TpoolResult *rPtr = tpoolPtr->workTail; if (rPtr == NULL) { return NULL; } tpoolPtr->workTail = rPtr->prevPtr; SpliceOut(rPtr, tpoolPtr->workHead); rPtr->nextPtr = rPtr->prevPtr = NULL; return rPtr; } /* *---------------------------------------------------------------------- * * PushWaiter -- * * Adds a waiter thread to the end of the waiters list. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void PushWaiter(tpoolPtr) ThreadPool *tpoolPtr; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); SpliceIn(tsdPtr->waitPtr, tpoolPtr->waitHead); if (tpoolPtr->waitTail == NULL) { tpoolPtr->waitTail = tsdPtr->waitPtr; } } /* *---------------------------------------------------------------------- * * PopWaiter -- * * Pops the first waiter from the head of the waiters list. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static TpoolWaiter* PopWaiter(tpoolPtr) ThreadPool *tpoolPtr; { TpoolWaiter *waitPtr = tpoolPtr->waitTail; if (waitPtr == NULL) { return NULL; } tpoolPtr->waitTail = waitPtr->prevPtr; SpliceOut(waitPtr, tpoolPtr->waitHead); waitPtr->prevPtr = waitPtr->nextPtr = NULL; return waitPtr; } /* *---------------------------------------------------------------------- * * GetTpool * * Parses the Tcl threadpool handle and locates the * corresponding threadpool maintenance structure. * * Results: * Pointer to the threadpool struct or NULL if none found, * * Side effects: * None. * *---------------------------------------------------------------------- */ static ThreadPool* GetTpool(tpoolName) const char *tpoolName; { ThreadPool *tpoolPtr; Tcl_MutexLock(&listMutex); tpoolPtr = GetTpoolUnl(tpoolName); Tcl_MutexUnlock(&listMutex); return tpoolPtr; } /* *---------------------------------------------------------------------- * * GetTpoolUnl * * Parses the threadpool handle and locates the * corresponding threadpool maintenance structure. * Assumes caller holds the listMutex, * * Results: * Pointer to the threadpool struct or NULL if none found, * * Side effects: * None. * *---------------------------------------------------------------------- */ static ThreadPool* GetTpoolUnl (tpoolName) const char *tpoolName; { ThreadPool *tpool; ThreadPool *tpoolPtr = NULL; if (sscanf(tpoolName, TPOOL_HNDLPREFIX"%p", &tpool) != 1) { return NULL; } for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolPtr->nextPtr) { if (tpoolPtr == tpool) { break; } } return tpoolPtr; } /* *---------------------------------------------------------------------- * * TpoolEval * * Evaluates the script and fills in the result structure. * * Results: * Standard Tcl result, * * Side effects: * Many, depending on the script. * *---------------------------------------------------------------------- */ static int TpoolEval(interp, script, scriptLen, rPtr) Tcl_Interp *interp; char *script; int scriptLen; TpoolResult *rPtr; { int ret, reslen; char *result, *errorCode, *errorInfo; ret = Tcl_EvalEx(interp, script, scriptLen, TCL_EVAL_GLOBAL); if (rPtr == NULL || rPtr->detached) { return ret; } rPtr->retcode = ret; if (ret == TCL_ERROR) { errorCode = (char*)Tcl_GetVar(interp, "errorCode", TCL_GLOBAL_ONLY); errorInfo = (char*)Tcl_GetVar(interp, "errorInfo", TCL_GLOBAL_ONLY); if (errorCode != NULL) { rPtr->errorCode = Tcl_Alloc(1 + strlen(errorCode)); strcpy(rPtr->errorCode, errorCode); } if (errorInfo != NULL) { rPtr->errorInfo = Tcl_Alloc(1 + strlen(errorInfo)); strcpy(rPtr->errorInfo, errorInfo); } } result = (char*)Tcl_GetStringResult(interp); reslen = strlen(result); if (reslen == 0) { rPtr->result = threadEmptyResult; } else { rPtr->result = strcpy(Tcl_Alloc(1 + reslen), result); } return ret; } /* *---------------------------------------------------------------------- * * SetResult * * Sets the result in current interpreter. * * Results: * Standard Tcl result, * * Side effects: * None. * *---------------------------------------------------------------------- */ static void SetResult(interp, rPtr) Tcl_Interp *interp; TpoolResult *rPtr; { if (rPtr->result) { if (rPtr->result == threadEmptyResult) { if (interp) { Tcl_ResetResult(interp); } } else { if (interp) { Tcl_SetObjResult(interp, Tcl_NewStringObj(rPtr->result,-1)); } Tcl_Free(rPtr->result); rPtr->result = NULL; } } if (rPtr->retcode == TCL_ERROR) { if (rPtr->errorCode) { if (interp) { Tcl_SetObjErrorCode(interp,Tcl_NewStringObj(rPtr->errorCode,-1)); } Tcl_Free(rPtr->errorCode); rPtr->errorCode = NULL; } if (rPtr->errorInfo) { if (interp) { Tcl_AddObjErrorInfo(interp, rPtr->errorInfo, -1); } Tcl_Free(rPtr->errorInfo); rPtr->errorInfo = NULL; } } } /* *---------------------------------------------------------------------- * * TpoolReserve -- * * Does the pool preserve and/or release. Assumes caller holds * the listMutex. * * Results: * None. * * Side effects: * May tear-down the threadpool if refcount drops to 0 or below. * *---------------------------------------------------------------------- */ static int TpoolReserve(tpoolPtr) ThreadPool *tpoolPtr; { return ++tpoolPtr->refCount; } /* *---------------------------------------------------------------------- * * TpoolRelease -- * * Does the pool preserve and/or release. Assumes caller holds * the listMutex. * * Results: * None. * * Side effects: * May tear-down the threadpool if refcount drops to 0 or below. * *---------------------------------------------------------------------- */ static int TpoolRelease(tpoolPtr) ThreadPool *tpoolPtr; { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); TpoolResult *rPtr; Tcl_HashEntry *hPtr; Tcl_HashSearch search; if (--tpoolPtr->refCount > 0) { return tpoolPtr->refCount; } /* * Pool is going away; remove from the list of pools, */ SpliceOut(tpoolPtr, tpoolList); InitWaiter(); /* * Signal and wait for all workers to die. */ tpoolPtr->tearDown = 1; Tcl_MutexLock(&tpoolPtr->mutex); while (tpoolPtr->numWorkers > 0) { PushWaiter(tpoolPtr); Tcl_ConditionNotify(&tpoolPtr->cond); Tcl_MutexUnlock(&tpoolPtr->mutex); tsdPtr->stop = -1; while(tsdPtr->stop == -1) { Tcl_DoOneEvent(TCL_ALL_EVENTS); } Tcl_MutexLock(&tpoolPtr->mutex); } Tcl_MutexUnlock(&tpoolPtr->mutex); /* * Tear down the pool structure */ if (tpoolPtr->initScript) { Tcl_Free(tpoolPtr->initScript); } if (tpoolPtr->exitScript) { Tcl_Free(tpoolPtr->exitScript); } /* * Cleanup completed but not collected jobs */ hPtr = Tcl_FirstHashEntry(&tpoolPtr->jobsDone, &search); while (hPtr != NULL) { rPtr = (TpoolResult*)Tcl_GetHashValue(hPtr); if (rPtr->result && rPtr->result != threadEmptyResult) { Tcl_Free(rPtr->result); } if (rPtr->retcode == TCL_ERROR) { if (rPtr->errorInfo) { Tcl_Free(rPtr->errorInfo); } if (rPtr->errorCode) { Tcl_Free(rPtr->errorCode); } } Tcl_Free((char*)rPtr); Tcl_DeleteHashEntry(hPtr); hPtr = Tcl_NextHashEntry(&search); } Tcl_DeleteHashTable(&tpoolPtr->jobsDone); /* * Cleanup jobs posted but never completed. */ for (rPtr = tpoolPtr->workHead; rPtr; rPtr = rPtr->nextPtr) { Tcl_Free(rPtr->script); Tcl_Free((char*)rPtr); } Tcl_MutexFinalize(&tpoolPtr->mutex); Tcl_ConditionFinalize(&tpoolPtr->cond); Tcl_Free((char*)tpoolPtr); return 0; } /* *---------------------------------------------------------------------- * * TpoolSuspend -- * * Marks the pool as suspended. This prevents pool workers to drain * the pool work queue. * * Results: * Value of the suspend flag (1 always). * * Side effects: * During the suspended state, pool worker threads wlll not timeout * even if the worker inactivity timer has been configured. * *---------------------------------------------------------------------- */ static void TpoolSuspend(tpoolPtr) ThreadPool *tpoolPtr; { Tcl_MutexLock(&tpoolPtr->mutex); tpoolPtr->suspend = 1; Tcl_MutexUnlock(&tpoolPtr->mutex); } /* *---------------------------------------------------------------------- * * TpoolResume -- * * Clears the pool suspended state. This allows pool workers to drain * the pool work queue again. * * Results: * None. * * Side effects: * Pool workers may be started or awaken. * *---------------------------------------------------------------------- */ static void TpoolResume(tpoolPtr) ThreadPool *tpoolPtr; { Tcl_MutexLock(&tpoolPtr->mutex); tpoolPtr->suspend = 0; Tcl_ConditionNotify(&tpoolPtr->cond); Tcl_MutexUnlock(&tpoolPtr->mutex); } /* *---------------------------------------------------------------------- * * SignalWaiter -- * * Signals the waiter thread. * * Results: * None. * * Side effects: * The waiter thread will exit from the event loop. * *---------------------------------------------------------------------- */ static void SignalWaiter(tpoolPtr) ThreadPool *tpoolPtr; { TpoolWaiter *waitPtr; Tcl_Event *evPtr; waitPtr = PopWaiter(tpoolPtr); if (waitPtr == NULL) { return; } evPtr = (Tcl_Event*)Tcl_Alloc(sizeof(Tcl_Event)); evPtr->proc = RunStopEvent; Tcl_ThreadQueueEvent(waitPtr->threadId,(Tcl_Event*)evPtr,TCL_QUEUE_TAIL); Tcl_ThreadAlert(waitPtr->threadId); } /* *---------------------------------------------------------------------- * * InitWaiter -- * * Setup poster thread to be able to wait in the event loop. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void InitWaiter () { ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey); if (tsdPtr->waitPtr == NULL) { tsdPtr->waitPtr = (TpoolWaiter*)Tcl_Alloc(sizeof(TpoolWaiter)); tsdPtr->waitPtr->prevPtr = NULL; tsdPtr->waitPtr->nextPtr = NULL; tsdPtr->waitPtr->threadId = Tcl_GetCurrentThread(); Tcl_CreateThreadExitHandler(ThrExitHandler, (ClientData)tsdPtr); } } /* *---------------------------------------------------------------------- * * ThrExitHandler -- * * Performs cleanup when a caller (poster) thread exits. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void ThrExitHandler(clientData) ClientData clientData; { ThreadSpecificData *tsdPtr = (ThreadSpecificData *)clientData; Tcl_Free((char*)tsdPtr->waitPtr); } /* *---------------------------------------------------------------------- * * AppExitHandler * * Deletes all threadpools on application exit. * * Results: * None. * * Side effects: * None. * *---------------------------------------------------------------------- */ static void AppExitHandler(clientData) ClientData clientData; { ThreadPool *tpoolPtr; Tcl_MutexLock(&listMutex); /* * Restart with head of list each time until empty. [Bug 1427570] */ for (tpoolPtr = tpoolList; tpoolPtr; tpoolPtr = tpoolList) { TpoolRelease(tpoolPtr); } Tcl_MutexUnlock(&listMutex); } /* *---------------------------------------------------------------------- * * Tpool_Init -- * * Create commands in current interpreter. * * Results: * None. * * Side effects: * On first load, creates application exit handler to clean up * any threadpools left. * *---------------------------------------------------------------------- */ int Tpool_Init (interp) Tcl_Interp *interp; /* Interp where to create cmds */ { static int initialized; TCL_CMD(interp, TPOOL_CMD_PREFIX"create", TpoolCreateObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"names", TpoolNamesObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"post", TpoolPostObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"wait", TpoolWaitObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"cancel", TpoolCancelObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"get", TpoolGetObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"preserve", TpoolReserveObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"release", TpoolReleaseObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"suspend", TpoolSuspendObjCmd); TCL_CMD(interp, TPOOL_CMD_PREFIX"resume", TpoolResumeObjCmd); if (initialized == 0) { Tcl_MutexLock(&listMutex); if (initialized == 0) { Tcl_CreateExitHandler(AppExitHandler, (ClientData)-1); initialized = 1; } Tcl_MutexUnlock(&listMutex); } return TCL_OK; } /* EOF $RCSfile: threadPoolCmd.c,v $ */ /* Emacs Setup Variables */ /* Local Variables: */ /* mode: C */ /* indent-tabs-mode: nil */ /* c-basic-offset: 4 */ /* End: */