OpenFPGA/libs/EXTERNAL/tcl8.6.12/pkgs/thread2.8.7/generic/threadSpCmd.c

1935 lines
49 KiB
C
Raw Normal View History

2022-06-07 11:15:20 -05:00
/*
* threadSpCmd.c --
*
* This file implements commands for script-level access to thread
* synchronization primitives. Currently, the exclusive mutex, the
* recursive mutex. the reader/writer mutex and condition variable
* objects are exposed to the script programmer.
*
* Additionaly, a locked eval is also implemented. This is a practical
* convenience function which relieves the programmer from the need
* to take care about unlocking some mutex after evaluating a protected
* part of code. The locked eval is recursive-savvy since it used the
* recursive mutex for internal locking.
*
* The Tcl interface to the locking and synchronization primitives
* attempts to catch some very common problems in thread programming
* like attempting to lock an exclusive mutex twice from the same
* thread (deadlock), waiting on the condition variable without
* locking the mutex, destroying primitives while being used, etc...
* This all comes with some additional internal locking costs but
* the benefits outweight the costs, especially considering overall
* performance (or lack of it) of an interpreted laguage like Tcl is.
*
* 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.
* ----------------------------------------------------------------------------
*/
#include "tclThreadInt.h"
#include "threadSpCmd.h"
/*
* Types of synchronization variables we support.
*/
#define EMUTEXID 'm' /* First letter of the exclusive mutex name */
#define RMUTEXID 'r' /* First letter of the recursive mutex name */
#define WMUTEXID 'w' /* First letter of the read/write mutex name */
#define CONDVID 'c' /* First letter of the condition variable name */
#define SP_MUTEX 1 /* Any kind of mutex */
#define SP_CONDV 2 /* The condition variable sync type */
/*
* Structure representing one sync primitive (mutex, condition variable).
* We use buckets to manage Tcl names of sync primitives. Each bucket
* is associated with a mutex. Each time we process the Tcl name of an
* sync primitive, we compute it's (trivial) hash and use this hash to
* address one of pre-allocated buckets.
* The bucket internally utilzes a hash-table to store item pointers.
* Item pointers are identified by a simple xid1, xid2... counting
* handle. This format is chosen to simplify distribution of handles
* across buckets (natural distribution vs. hash-one as in shared vars).
*/
typedef struct _SpItem {
int refcnt; /* Number of threads operating on the item */
SpBucket *bucket; /* Bucket where this item is stored */
Tcl_HashEntry *hentry; /* Hash table entry where this item is stored */
} SpItem;
/*
* Structure representing a mutex.
*/
typedef struct _SpMutex {
int refcnt; /* Number of threads operating on the mutex */
SpBucket *bucket; /* Bucket where mutex is stored */
Tcl_HashEntry *hentry; /* Hash table entry where mutex is stored */
/* --- */
char type; /* Type of the mutex */
Sp_AnyMutex *lock; /* Exclusive, recursive or read/write mutex */
} SpMutex;
/*
* Structure representing a condition variable.
*/
typedef struct _SpCondv {
int refcnt; /* Number of threads operating on the variable */
SpBucket *bucket; /* Bucket where this variable is stored */
Tcl_HashEntry *hentry; /* Hash table entry where variable is stored */
/* --- */
SpMutex *mutex; /* Set when waiting on the variable */
Tcl_Condition cond; /* The condition variable itself */
} SpCondv;
/*
* This global data is used to map opaque Tcl-level names
* to pointers of their corresponding synchronization objects.
*/
static int initOnce; /* Flag for initializing tables below */
static Tcl_Mutex initMutex; /* Controls initialization of primitives */
static SpBucket muxBuckets[NUMSPBUCKETS]; /* Maps mutex names/handles */
static SpBucket varBuckets[NUMSPBUCKETS]; /* Maps condition variable
* names/handles */
/*
* Functions implementing Tcl commands
*/
static Tcl_ObjCmdProc ThreadMutexObjCmd;
static Tcl_ObjCmdProc ThreadRWMutexObjCmd;
static Tcl_ObjCmdProc ThreadCondObjCmd;
static Tcl_ObjCmdProc ThreadEvalObjCmd;
/*
* Forward declaration of functions used only within this file
*/
static int SpMutexLock (SpMutex *);
static int SpMutexUnlock (SpMutex *);
static int SpMutexFinalize (SpMutex *);
static int SpCondvWait (SpCondv *, SpMutex *, int);
static void SpCondvNotify (SpCondv *);
static int SpCondvFinalize (SpCondv *);
static void AddAnyItem (int, const char *, size_t, SpItem *);
static SpItem* GetAnyItem (int, const char *, size_t);
static void PutAnyItem (SpItem *);
static SpItem * RemoveAnyItem (int, const char*, size_t);
static int RemoveMutex (const char *, size_t);
static int RemoveCondv (const char *, size_t);
static Tcl_Obj* GetName (int, void *);
static SpBucket* GetBucket (int, const char *, size_t);
static int AnyMutexIsLocked (Sp_AnyMutex *mPtr, Tcl_ThreadId);
/*
* Function-like macros for some frequently used calls
*/
#define AddMutex(a,b,c) AddAnyItem(SP_MUTEX, (a), (b), (SpItem*)(c))
#define GetMutex(a,b) (SpMutex*)GetAnyItem(SP_MUTEX, (a), (b))
#define PutMutex(a) PutAnyItem((SpItem*)(a))
#define AddCondv(a,b,c) AddAnyItem(SP_CONDV, (a), (b), (SpItem*)(c))
#define GetCondv(a,b) (SpCondv*)GetAnyItem(SP_CONDV, (a), (b))
#define PutCondv(a) PutAnyItem((SpItem*)(a))
#define IsExclusive(a) ((a)->type == EMUTEXID)
#define IsRecursive(a) ((a)->type == RMUTEXID)
#define IsReadWrite(a) ((a)->type == WMUTEXID)
/*
* This macro produces a hash-value for table-lookups given a handle
* and its length. It is implemented as macro just for speed.
* It is actually a trivial thing because the handles are simple
* counting values with a small three-letter prefix.
*/
#define GetHash(a,b) (atoi((a)+((b) < 4 ? 0 : 3)) % NUMSPBUCKETS)
/*
*----------------------------------------------------------------------
*
* ThreadMutexObjCmd --
*
* This procedure is invoked to process "thread::mutex" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ThreadMutexObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
int opt, ret;
size_t nameLen;
const char *mutexName;
char type;
SpMutex *mutexPtr;
static const char *cmdOpts[] = {
"create", "destroy", "lock", "unlock", NULL
};
enum options {
m_CREATE, m_DESTROY, m_LOCK, m_UNLOCK
};
(void)dummy;
/*
* Syntax:
*
* thread::mutex create ?-recursive?
* thread::mutex destroy <mutexHandle>
* thread::mutex lock <mutexHandle>
* thread::mutex unlock <mutexHandle>
*/
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
ret = Tcl_GetIndexFromObjStruct(interp, objv[1], cmdOpts, sizeof(char *), "option", 0, &opt);
if (ret != TCL_OK) {
return TCL_ERROR;
}
/*
* Cover the "create" option first. It needs no existing handle.
*/
if (opt == (int)m_CREATE) {
Tcl_Obj *nameObj;
const char *arg;
/*
* Parse out which type of mutex to create
*/
if (objc == 2) {
type = EMUTEXID;
} else if (objc > 3) {
Tcl_WrongNumArgs(interp, 2, objv, "?-recursive?");
return TCL_ERROR;
} else {
arg = Tcl_GetString(objv[2]);
if (OPT_CMP(arg, "-recursive")) {
type = RMUTEXID;
} else {
Tcl_WrongNumArgs(interp, 2, objv, "?-recursive?");
return TCL_ERROR;
}
}
/*
* Create the requested mutex
*/
mutexPtr = (SpMutex*)ckalloc(sizeof(SpMutex));
mutexPtr->type = type;
mutexPtr->bucket = NULL;
mutexPtr->hentry = NULL;
mutexPtr->lock = NULL; /* Will be auto-initialized */
/*
* Generate Tcl name for this mutex
*/
nameObj = GetName(mutexPtr->type, (void*)mutexPtr);
mutexName = Tcl_GetString(nameObj);
nameLen = nameObj->length;
AddMutex(mutexName, nameLen, mutexPtr);
Tcl_SetObjResult(interp, nameObj);
return TCL_OK;
}
/*
* All other options require a valid name.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "mutexHandle");
return TCL_ERROR;
}
mutexName = Tcl_GetString(objv[2]);
nameLen = objv[2]->length;
/*
* Try mutex destroy
*/
if (opt == (int)m_DESTROY) {
ret = RemoveMutex(mutexName, nameLen);
if (ret <= 0) {
if (ret == -1) {
notfound:
Tcl_AppendResult(interp, "no such mutex \"", mutexName,
"\"", NULL);
return TCL_ERROR;
} else {
Tcl_AppendResult(interp, "mutex is in use", NULL);
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
* Try all other options
*/
mutexPtr = GetMutex(mutexName, nameLen);
if (mutexPtr == NULL) {
goto notfound;
}
if (!IsExclusive(mutexPtr) && !IsRecursive(mutexPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "wrong mutex type, must be either"
" exclusive or recursive", NULL);
return TCL_ERROR;
}
switch ((enum options)opt) {
case m_LOCK:
if (!SpMutexLock(mutexPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "locking the same exclusive mutex "
"twice from the same thread", NULL);
return TCL_ERROR;
}
break;
case m_UNLOCK:
if (!SpMutexUnlock(mutexPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "mutex is not locked", NULL);
return TCL_ERROR;
}
break;
default:
break;
}
PutMutex(mutexPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ThreadRwMutexObjCmd --
*
* This procedure is invoked to process "thread::rwmutex" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ThreadRWMutexObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
int opt, ret;
size_t nameLen;
const char *mutexName;
SpMutex *mutexPtr;
Sp_ReadWriteMutex *rwPtr;
Sp_AnyMutex **lockPtr;
static const char *cmdOpts[] = {
"create", "destroy", "rlock", "wlock", "unlock", NULL
};
enum options {
w_CREATE, w_DESTROY, w_RLOCK, w_WLOCK, w_UNLOCK
};
(void)dummy;
/*
* Syntax:
*
* thread::rwmutex create
* thread::rwmutex destroy <mutexHandle>
* thread::rwmutex rlock <mutexHandle>
* thread::rwmutex wlock <mutexHandle>
* thread::rwmutex unlock <mutexHandle>
*/
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
ret = Tcl_GetIndexFromObjStruct(interp, objv[1], cmdOpts, sizeof(char *), "option", 0, &opt);
if (ret != TCL_OK) {
return TCL_ERROR;
}
/*
* Cover the "create" option first, since it needs no existing name.
*/
if (opt == (int)w_CREATE) {
Tcl_Obj *nameObj;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "create");
return TCL_ERROR;
}
mutexPtr = (SpMutex*)ckalloc(sizeof(SpMutex));
mutexPtr->type = WMUTEXID;
mutexPtr->refcnt = 0;
mutexPtr->bucket = NULL;
mutexPtr->hentry = NULL;
mutexPtr->lock = NULL; /* Will be auto-initialized */
nameObj = GetName(mutexPtr->type, (void*)mutexPtr);
mutexName = Tcl_GetString(nameObj);
AddMutex(mutexName, nameObj->length, mutexPtr);
Tcl_SetObjResult(interp, nameObj);
return TCL_OK;
}
/*
* All other options require a valid name.
*/
if (objc != 3) {
Tcl_WrongNumArgs(interp, 2, objv, "mutexHandle");
return TCL_ERROR;
}
mutexName = Tcl_GetString(objv[2]);
nameLen = objv[2]->length;
/*
* Try mutex destroy
*/
if (opt == (int)w_DESTROY) {
ret = RemoveMutex(mutexName, nameLen);
if (ret <= 0) {
if (ret == -1) {
notfound:
Tcl_AppendResult(interp, "no such mutex \"", mutexName,
"\"", NULL);
return TCL_ERROR;
} else {
Tcl_AppendResult(interp, "mutex is in use", NULL);
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
* Try all other options
*/
mutexPtr = GetMutex(mutexName, nameLen);
if (mutexPtr == NULL) {
goto notfound;
}
if (!IsReadWrite(mutexPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "wrong mutex type, must be readwrite", NULL);
return TCL_ERROR;
}
lockPtr = &mutexPtr->lock;
rwPtr = (Sp_ReadWriteMutex*) lockPtr;
switch ((enum options)opt) {
case w_RLOCK:
if (!Sp_ReadWriteMutexRLock(rwPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "read-locking already write-locked mutex ",
"from the same thread", NULL);
return TCL_ERROR;
}
break;
case w_WLOCK:
if (!Sp_ReadWriteMutexWLock(rwPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "write-locking the same read-write "
"mutex twice from the same thread", NULL);
return TCL_ERROR;
}
break;
case w_UNLOCK:
if (!Sp_ReadWriteMutexUnlock(rwPtr)) {
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "mutex is not locked", NULL);
return TCL_ERROR;
}
break;
default:
break;
}
PutMutex(mutexPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ThreadCondObjCmd --
*
* This procedure is invoked to process "thread::cond" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ThreadCondObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
int opt, ret, timeMsec = 0;
size_t nameLen;
const char *condvName, *mutexName;
SpMutex *mutexPtr;
SpCondv *condvPtr;
static const char *cmdOpts[] = {
"create", "destroy", "notify", "wait", NULL
};
enum options {
c_CREATE, c_DESTROY, c_NOTIFY, c_WAIT
};
(void)dummy;
/*
* Syntax:
*
* thread::cond create
* thread::cond destroy <condHandle>
* thread::cond notify <condHandle>
* thread::cond wait <condHandle> <mutexHandle> ?timeout?
*/
if (objc < 2) {
Tcl_WrongNumArgs(interp, 1, objv, "option ?args?");
return TCL_ERROR;
}
ret = Tcl_GetIndexFromObjStruct(interp, objv[1], cmdOpts, sizeof(char *), "option", 0, &opt);
if (ret != TCL_OK) {
return TCL_ERROR;
}
/*
* Cover the "create" option since it needs no existing name.
*/
if (opt == (int)c_CREATE) {
Tcl_Obj *nameObj;
if (objc > 2) {
Tcl_WrongNumArgs(interp, 1, objv, "create");
return TCL_ERROR;
}
condvPtr = (SpCondv*)ckalloc(sizeof(SpCondv));
condvPtr->refcnt = 0;
condvPtr->bucket = NULL;
condvPtr->hentry = NULL;
condvPtr->mutex = NULL;
condvPtr->cond = NULL; /* Will be auto-initialized */
nameObj = GetName(CONDVID, (void*)condvPtr);
condvName = Tcl_GetString(nameObj);
AddCondv(condvName, nameObj->length, condvPtr);
Tcl_SetObjResult(interp, nameObj);
return TCL_OK;
}
/*
* All others require at least a valid handle.
*/
if (objc < 3) {
Tcl_WrongNumArgs(interp, 2, objv, "condHandle ?args?");
return TCL_ERROR;
}
condvName = Tcl_GetString(objv[2]);
nameLen = objv[2]->length;
/*
* Try variable destroy.
*/
if (opt == (int)c_DESTROY) {
ret = RemoveCondv(condvName, nameLen);
if (ret <= 0) {
if (ret == -1) {
notfound:
Tcl_AppendResult(interp, "no such condition variable \"",
condvName, "\"", NULL);
return TCL_ERROR;
} else {
Tcl_AppendResult(interp, "condition variable is in use", NULL);
return TCL_ERROR;
}
}
return TCL_OK;
}
/*
* Try all other options
*/
condvPtr = GetCondv(condvName, nameLen);
if (condvPtr == NULL) {
goto notfound;
}
switch ((enum options)opt) {
case c_WAIT:
/*
* May improve the Tcl_ConditionWait() to report timeouts so we can
* inform script programmer about this interesting fact. I think
* there is still a place for something like Tcl_ConditionWaitEx()
* or similar in the core.
*/
if (objc < 4 || objc > 5) {
PutCondv(condvPtr);
Tcl_WrongNumArgs(interp, 2, objv, "condHandle mutexHandle ?timeout?");
return TCL_ERROR;
}
if (objc == 5) {
if (Tcl_GetIntFromObj(interp, objv[4], &timeMsec) != TCL_OK) {
PutCondv(condvPtr);
return TCL_ERROR;
}
}
mutexName = Tcl_GetString(objv[3]);
mutexPtr = GetMutex(mutexName, objv[3]->length);
if (mutexPtr == NULL) {
PutCondv(condvPtr);
Tcl_AppendResult(interp, "no such mutex \"",mutexName,"\"", NULL);
return TCL_ERROR;
}
if (!IsExclusive(mutexPtr)
|| SpCondvWait(condvPtr, mutexPtr, timeMsec) == 0) {
PutCondv(condvPtr);
PutMutex(mutexPtr);
Tcl_AppendResult(interp, "mutex not locked or wrong type", NULL);
return TCL_ERROR;
}
PutMutex(mutexPtr);
break;
case c_NOTIFY:
SpCondvNotify(condvPtr);
break;
default:
break;
}
PutCondv(condvPtr);
return TCL_OK;
}
/*
*----------------------------------------------------------------------
*
* ThreadEvalObjCmd --
*
* This procedure is invoked to process "thread::eval" Tcl command.
* See the user documentation for details on what it does.
*
* Results:
* A standard Tcl result.
*
* Side effects:
* See the user documentation.
*
*----------------------------------------------------------------------
*/
static int
ThreadEvalObjCmd(
ClientData dummy, /* Not used. */
Tcl_Interp *interp, /* Current interpreter. */
int objc, /* Number of arguments. */
Tcl_Obj *const objv[] /* Argument objects. */
) {
int ret, optx, internal;
const char *mutexName;
Tcl_Obj *scriptObj;
SpMutex *mutexPtr = NULL;
static Sp_RecursiveMutex evalMutex;
(void)dummy;
/*
* Syntax:
*
* thread::eval ?-lock <mutexHandle>? arg ?arg ...?
*/
if (objc < 2) {
syntax:
Tcl_WrongNumArgs(interp, 1, objv,
"?-lock <mutexHandle>? arg ?arg...?");
return TCL_ERROR;
}
/*
* Find out wether to use the internal (recursive) mutex
* or external mutex given on the command line, and lock
* the corresponding mutex immediately.
*
* We are using recursive internal mutex so we can easily
* support the recursion w/o danger of deadlocking. If
* however, user gives us an exclusive mutex, we will
* throw error on attempt to recursively call us.
*/
if (OPT_CMP(Tcl_GetString(objv[1]), "-lock") == 0) {
internal = 1;
optx = 1;
Sp_RecursiveMutexLock(&evalMutex);
} else {
internal = 0;
optx = 3;
if ((objc - optx) < 1) {
goto syntax;
}
mutexName = Tcl_GetString(objv[2]);
mutexPtr = GetMutex(mutexName, objv[2]->length);
if (mutexPtr == NULL) {
Tcl_AppendResult(interp, "no such mutex \"",mutexName,"\"", NULL);
return TCL_ERROR;
}
if (IsReadWrite(mutexPtr)) {
Tcl_AppendResult(interp, "wrong mutex type, must be exclusive "
"or recursive", NULL);
return TCL_ERROR;
}
if (!SpMutexLock(mutexPtr)) {
Tcl_AppendResult(interp, "locking the same exclusive mutex "
"twice from the same thread", NULL);
return TCL_ERROR;
}
}
objc -= optx;
/*
* Evaluate passed arguments as Tcl script. Note that
* Tcl_EvalObjEx throws away the passed object by
* doing an decrement reference count on it. This also
* means we need not build object bytecode rep.
*/
if (objc == 1) {
scriptObj = Tcl_DuplicateObj(objv[optx]);
} else {
scriptObj = Tcl_ConcatObj(objc, objv + optx);
}
Tcl_IncrRefCount(scriptObj);
ret = Tcl_EvalObjEx(interp, scriptObj, TCL_EVAL_DIRECT);
Tcl_DecrRefCount(scriptObj);
if (ret == TCL_ERROR) {
char msg[32 + TCL_INTEGER_SPACE];
/* Next line generates a Deprecation warning when compiled with Tcl 8.6.
* See Tcl bug #3562640 */
sprintf(msg, "\n (\"eval\" body line %d)", Tcl_GetErrorLine(interp));
Tcl_AddErrorInfo(interp, msg);
}
/*
* Unlock the mutex.
*/
if (internal) {
Sp_RecursiveMutexUnlock(&evalMutex);
} else {
SpMutexUnlock(mutexPtr);
}
return ret;
}
/*
*----------------------------------------------------------------------
*
* GetName --
*
* Construct a Tcl name for the given sync primitive.
* The name is in the simple counted form: XidN
* where "X" designates the type of the primitive
* and "N" is a increasing integer.
*
* Results:
* Tcl string object with the constructed name.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static Tcl_Obj*
GetName(int type, void *dummy)
{
char name[32];
unsigned int id;
static unsigned int idcounter;
(void)dummy;
Tcl_MutexLock(&initMutex);
id = idcounter++;
Tcl_MutexUnlock(&initMutex);
sprintf(name, "%cid%d", type, id);
return Tcl_NewStringObj(name, -1);
}
/*
*----------------------------------------------------------------------
*
* GetBucket --
*
* Returns the bucket for the given name.
*
* Results:
* Pointer to the bucket.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static SpBucket*
GetBucket(int type, const char *name, size_t len)
{
switch (type) {
case SP_MUTEX: return &muxBuckets[GetHash(name, len)];
case SP_CONDV: return &varBuckets[GetHash(name, len)];
}
return NULL; /* Never reached */
}
/*
*----------------------------------------------------------------------
*
* GetAnyItem --
*
* Retrieves the item structure from it's corresponding bucket.
*
* Results:
* Item pointer or NULL
*
* Side effects:
* Increment the item's ref count preventing it's deletion.
*
*----------------------------------------------------------------------
*/
static SpItem*
GetAnyItem(int type, const char *name, size_t len)
{
SpItem *itemPtr = NULL;
SpBucket *bucketPtr = GetBucket(type, name, len);
Tcl_HashEntry *hashEntryPtr = NULL;
Tcl_MutexLock(&bucketPtr->lock);
hashEntryPtr = Tcl_FindHashEntry(&bucketPtr->handles, name);
if (hashEntryPtr != NULL) {
itemPtr = (SpItem*)Tcl_GetHashValue(hashEntryPtr);
itemPtr->refcnt++;
}
Tcl_MutexUnlock(&bucketPtr->lock);
return itemPtr;
}
/*
*----------------------------------------------------------------------
*
* PutAnyItem --
*
* Current thread detaches from the item.
*
* Results:
* None.
*
* Side effects:
* Decrement item's ref count allowing for it's deletion
* and signalize any threads waiting to delete the item.
*
*----------------------------------------------------------------------
*/
static void
PutAnyItem(SpItem *itemPtr)
{
Tcl_MutexLock(&itemPtr->bucket->lock);
itemPtr->refcnt--;
Tcl_ConditionNotify(&itemPtr->bucket->cond);
Tcl_MutexUnlock(&itemPtr->bucket->lock);
}
/*
*----------------------------------------------------------------------
*
* AddAnyItem --
*
* Puts any item in the corresponding bucket.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
AddAnyItem(int type, const char *handle, size_t len, SpItem *itemPtr)
{
int isNew;
SpBucket *bucketPtr = GetBucket(type, handle, len);
Tcl_HashEntry *hashEntryPtr;
Tcl_MutexLock(&bucketPtr->lock);
hashEntryPtr = Tcl_CreateHashEntry(&bucketPtr->handles, handle, &isNew);
Tcl_SetHashValue(hashEntryPtr, itemPtr);
itemPtr->refcnt = 0;
itemPtr->bucket = bucketPtr;
itemPtr->hentry = hashEntryPtr;
Tcl_MutexUnlock(&bucketPtr->lock);
}
/*
*----------------------------------------------------------------------
*
* RemoveAnyItem --
*
* Removes the item from it's bucket.
*
* Results:
* Item's pointer or NULL if none found.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static SpItem *
RemoveAnyItem(int type, const char *name, size_t len)
{
SpItem *itemPtr = NULL;
SpBucket *bucketPtr = GetBucket(type, name, len);
Tcl_HashEntry *hashEntryPtr = NULL;
Tcl_MutexLock(&bucketPtr->lock);
hashEntryPtr = Tcl_FindHashEntry(&bucketPtr->handles, name);
if (hashEntryPtr == NULL) {
Tcl_MutexUnlock(&bucketPtr->lock);
return NULL;
}
itemPtr = (SpItem*)Tcl_GetHashValue(hashEntryPtr);
Tcl_DeleteHashEntry(hashEntryPtr);
while (itemPtr->refcnt > 0) {
Tcl_ConditionWait(&bucketPtr->cond, &bucketPtr->lock, NULL);
}
Tcl_MutexUnlock(&bucketPtr->lock);
return itemPtr;
}
/*
*----------------------------------------------------------------------
*
* RemoveMutex --
*
* Removes the mutex from it's bucket and finalizes it.
*
* Results:
* 1 - mutex is finalized and removed
* 0 - mutex is not finalized
+ -1 - mutex is not found
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
RemoveMutex(const char *name, size_t len)
{
SpMutex *mutexPtr = GetMutex(name, len);
if (mutexPtr == NULL) {
return -1;
}
if (!SpMutexFinalize(mutexPtr)) {
PutMutex(mutexPtr);
return 0;
}
PutMutex(mutexPtr);
RemoveAnyItem(SP_MUTEX, name, len);
ckfree((char*)mutexPtr);
return 1;
}
/*
*----------------------------------------------------------------------
*
* RemoveCondv --
*
* Removes the cond variable from it's bucket and finalizes it.
*
* Results:
* 1 - variable is finalized and removed
* 0 - variable is not finalized
+ -1 - variable is not found
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
RemoveCondv(const char *name, size_t len)
{
SpCondv *condvPtr = GetCondv(name, len);
if (condvPtr == NULL) {
return -1;
}
if (!SpCondvFinalize(condvPtr)) {
PutCondv(condvPtr);
return 0;
}
PutCondv(condvPtr);
RemoveAnyItem(SP_CONDV, name, len);
ckfree((char*)condvPtr);
return 1;
}
/*
*----------------------------------------------------------------------
*
* SpInit --
*
* Create commands in current interpreter.
*
* Results:
* NULL
*
* Side effects:
* Initializes shared hash table for storing sync primitive
* handles and pointers.
*
*----------------------------------------------------------------------
*/
const char *
SpInit (
Tcl_Interp *interp /* Interp where to create cmds */
) {
SpBucket *bucketPtr;
if (!initOnce) {
Tcl_MutexLock(&initMutex);
if (!initOnce) {
int ii;
for (ii = 0; ii < NUMSPBUCKETS; ii++) {
bucketPtr = &muxBuckets[ii];
memset(bucketPtr, 0, sizeof(SpBucket));
Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS);
}
for (ii = 0; ii < NUMSPBUCKETS; ii++) {
bucketPtr = &varBuckets[ii];
memset(bucketPtr, 0, sizeof(SpBucket));
Tcl_InitHashTable(&bucketPtr->handles, TCL_STRING_KEYS);
}
initOnce = 1;
}
Tcl_MutexUnlock(&initMutex);
}
TCL_CMD(interp, THREAD_CMD_PREFIX"::mutex", ThreadMutexObjCmd);
TCL_CMD(interp, THREAD_CMD_PREFIX"::rwmutex", ThreadRWMutexObjCmd);
TCL_CMD(interp, THREAD_CMD_PREFIX"::cond", ThreadCondObjCmd);
TCL_CMD(interp, THREAD_CMD_PREFIX"::eval", ThreadEvalObjCmd);
return NULL;
}
/*
*----------------------------------------------------------------------
*
* SpMutexLock --
*
* Locks the typed mutex.
*
* Results:
* 1 - mutex is locked
* 0 - mutex is not locked (pending deadlock?)
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
SpMutexLock(SpMutex *mutexPtr)
{
Sp_AnyMutex **lockPtr = &mutexPtr->lock;
switch (mutexPtr->type) {
case EMUTEXID:
return Sp_ExclusiveMutexLock((Sp_ExclusiveMutex*)lockPtr);
break;
case RMUTEXID:
return Sp_RecursiveMutexLock((Sp_RecursiveMutex*)lockPtr);
break;
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* SpMutexUnlock --
*
* Unlocks the typed mutex.
*
* Results:
* 1 - mutex is unlocked
* 0 - mutex was not locked
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
SpMutexUnlock(SpMutex *mutexPtr)
{
Sp_AnyMutex **lockPtr = &mutexPtr->lock;
switch (mutexPtr->type) {
case EMUTEXID:
return Sp_ExclusiveMutexUnlock((Sp_ExclusiveMutex*)lockPtr);
break;
case RMUTEXID:
return Sp_RecursiveMutexUnlock((Sp_RecursiveMutex*)lockPtr);
break;
}
return 0;
}
/*
*----------------------------------------------------------------------
*
* SpMutexFinalize --
*
* Finalizes the typed mutex. This should never be called without
* some external mutex protection.
*
* Results:
* 1 - mutex is finalized
* 0 - mutex is still in use
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
SpMutexFinalize(SpMutex *mutexPtr)
{
Sp_AnyMutex **lockPtr = &mutexPtr->lock;
if (AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, NULL)) {
return 0;
}
/*
* At this point, the mutex could be locked again, hence it
* is important never to call this function unprotected.
*/
switch (mutexPtr->type) {
case EMUTEXID:
Sp_ExclusiveMutexFinalize((Sp_ExclusiveMutex*)lockPtr);
break;
case RMUTEXID:
Sp_RecursiveMutexFinalize((Sp_RecursiveMutex*)lockPtr);
break;
case WMUTEXID:
Sp_ReadWriteMutexFinalize((Sp_ReadWriteMutex*)lockPtr);
break;
default:
break;
}
return 1;
}
/*
*----------------------------------------------------------------------
*
* SpCondvWait --
*
* Waits on the condition variable.
*
* Results:
* 1 - wait ok
* 0 - not waited as mutex is not locked in the same thread
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
SpCondvWait(SpCondv *condvPtr, SpMutex *mutexPtr, int msec)
{
Sp_AnyMutex **lock = &mutexPtr->lock;
Sp_ExclusiveMutex_ *emPtr = *(Sp_ExclusiveMutex_**)lock;
Tcl_Time waitTime, *wt = NULL;
Tcl_ThreadId threadId = Tcl_GetCurrentThread();
if (msec > 0) {
wt = &waitTime;
wt->sec = (msec/1000);
wt->usec = (msec%1000) * 1000;
}
if (!AnyMutexIsLocked((Sp_AnyMutex*)mutexPtr->lock, threadId)) {
return 0; /* Mutex not locked by the current thread */
}
/*
* It is safe to operate on mutex struct because caller
* is holding the emPtr->mutex locked before we enter
* the Tcl_ConditionWait and after we return out of it.
*/
condvPtr->mutex = mutexPtr;
emPtr->owner = NULL;
emPtr->lockcount = 0;
Tcl_ConditionWait(&condvPtr->cond, &emPtr->mutex, wt);
emPtr->owner = threadId;
emPtr->lockcount = 1;
condvPtr->mutex = NULL;
return 1;
}
/*
*----------------------------------------------------------------------
*
* SpCondvNotify --
*
* Signalizes the condition variable.
*
* Results:
* None.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static void
SpCondvNotify(SpCondv *condvPtr)
{
if (condvPtr->cond) {
Tcl_ConditionNotify(&condvPtr->cond);
}
}
/*
*----------------------------------------------------------------------
*
* SpCondvFinalize --
*
* Finalizes the condition variable.
*
* Results:
* 1 - variable is finalized
* 0 - variable is in use
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
SpCondvFinalize(SpCondv *condvPtr)
{
if (condvPtr->mutex != NULL) {
return 0; /* Somebody is waiting on the variable */
}
if (condvPtr->cond) {
Tcl_ConditionFinalize(&condvPtr->cond);
}
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_ExclusiveMutexLock --
*
* Locks the exclusive mutex.
*
* Results:
* 1 - mutex is locked
* 0 - mutex is not locked; same thread tries to locks twice
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_ExclusiveMutexLock(Sp_ExclusiveMutex *muxPtr)
{
Sp_ExclusiveMutex_ *emPtr;
Tcl_ThreadId thisThread = Tcl_GetCurrentThread();
/*
* Allocate the mutex structure on first access
*/
if (*muxPtr == (Sp_ExclusiveMutex_*)0) {
Tcl_MutexLock(&initMutex);
if (*muxPtr == (Sp_ExclusiveMutex_*)0) {
*muxPtr = (Sp_ExclusiveMutex_*)
ckalloc(sizeof(Sp_ExclusiveMutex_));
memset(*muxPtr, 0, sizeof(Sp_ExclusiveMutex_));
}
Tcl_MutexUnlock(&initMutex);
}
/*
* Try locking if not currently locked by anybody.
*/
emPtr = *(Sp_ExclusiveMutex_**)muxPtr;
Tcl_MutexLock(&emPtr->lock);
if (emPtr->lockcount && emPtr->owner == thisThread) {
Tcl_MutexUnlock(&emPtr->lock);
return 0; /* Already locked by the same thread */
}
Tcl_MutexUnlock(&emPtr->lock);
/*
* Many threads can come to this point.
* Only one will succeed locking the
* mutex. Others will block...
*/
Tcl_MutexLock(&emPtr->mutex);
Tcl_MutexLock(&emPtr->lock);
emPtr->owner = thisThread;
emPtr->lockcount = 1;
Tcl_MutexUnlock(&emPtr->lock);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_ExclusiveMutexIsLocked --
*
* Checks wether the mutex is locked or not.
*
* Results:
* 1 - mutex is locked
* 0 - mutex is not locked
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_ExclusiveMutexIsLocked(Sp_ExclusiveMutex *muxPtr)
{
return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, NULL);
}
/*
*----------------------------------------------------------------------
*
* Sp_ExclusiveMutexUnlock --
*
* Unlock the exclusive mutex.
*
* Results:
* 1 - mutex is unlocked
? 0 - mutex was never locked
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_ExclusiveMutexUnlock(Sp_ExclusiveMutex *muxPtr)
{
Sp_ExclusiveMutex_ *emPtr;
if (*muxPtr == (Sp_ExclusiveMutex_*)0) {
return 0; /* Never locked before */
}
emPtr = *(Sp_ExclusiveMutex_**)muxPtr;
Tcl_MutexLock(&emPtr->lock);
if (emPtr->lockcount == 0) {
Tcl_MutexUnlock(&emPtr->lock);
return 0; /* Not locked */
}
emPtr->owner = NULL;
emPtr->lockcount = 0;
Tcl_MutexUnlock(&emPtr->lock);
/*
* Only one thread should be able
* to come to this point and unlock...
*/
Tcl_MutexUnlock(&emPtr->mutex);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_ExclusiveMutexFinalize --
*
* Finalize the exclusive mutex. It is not safe for two or
* more threads to finalize the mutex at the same time.
*
* Results:
* None.
*
* Side effects:
* Mutex is destroyed.
*
*----------------------------------------------------------------------
*/
void
Sp_ExclusiveMutexFinalize(Sp_ExclusiveMutex *muxPtr)
{
if (*muxPtr != (Sp_ExclusiveMutex_*)0) {
Sp_ExclusiveMutex_ *emPtr = *(Sp_ExclusiveMutex_**)muxPtr;
if (emPtr->lock) {
Tcl_MutexFinalize(&emPtr->lock);
}
if (emPtr->mutex) {
Tcl_MutexFinalize(&emPtr->mutex);
}
ckfree((char*)*muxPtr);
}
}
/*
*----------------------------------------------------------------------
*
* Sp_RecursiveMutexLock --
*
* Locks the recursive mutex.
*
* Results:
* 1 - mutex is locked (as it always should be)
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_RecursiveMutexLock(Sp_RecursiveMutex *muxPtr)
{
Sp_RecursiveMutex_ *rmPtr;
Tcl_ThreadId thisThread = Tcl_GetCurrentThread();
/*
* Allocate the mutex structure on first access
*/
if (*muxPtr == (Sp_RecursiveMutex_*)0) {
Tcl_MutexLock(&initMutex);
if (*muxPtr == (Sp_RecursiveMutex_*)0) {
*muxPtr = (Sp_RecursiveMutex_*)
ckalloc(sizeof(Sp_RecursiveMutex_));
memset(*muxPtr, 0, sizeof(Sp_RecursiveMutex_));
}
Tcl_MutexUnlock(&initMutex);
}
rmPtr = *(Sp_RecursiveMutex_**)muxPtr;
Tcl_MutexLock(&rmPtr->lock);
if (rmPtr->owner == thisThread) {
/*
* We are already holding the mutex
* so just count one more lock.
*/
rmPtr->lockcount++;
} else {
if (rmPtr->owner == NULL) {
/*
* Nobody holds the mutex, we do now.
*/
rmPtr->owner = thisThread;
rmPtr->lockcount = 1;
} else {
/*
* Somebody else holds the mutex; wait.
*/
while (1) {
Tcl_ConditionWait(&rmPtr->cond, &rmPtr->lock, NULL);
if (rmPtr->owner == NULL) {
rmPtr->owner = thisThread;
rmPtr->lockcount = 1;
break;
}
}
}
}
Tcl_MutexUnlock(&rmPtr->lock);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_RecursiveMutexIsLocked --
*
* Checks wether the mutex is locked or not.
*
* Results:
* 1 - mutex is locked
* 0 - mutex is not locked
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_RecursiveMutexIsLocked(Sp_RecursiveMutex *muxPtr)
{
return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, NULL);
}
/*
*----------------------------------------------------------------------
*
* Sp_RecursiveMutexUnlock --
*
* Unlock the recursive mutex.
*
* Results:
* 1 - mutex unlocked
* 0 - mutex never locked
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_RecursiveMutexUnlock(Sp_RecursiveMutex *muxPtr)
{
Sp_RecursiveMutex_ *rmPtr;
if (*muxPtr == (Sp_RecursiveMutex_*)0) {
return 0; /* Never locked before */
}
rmPtr = *(Sp_RecursiveMutex_**)muxPtr;
Tcl_MutexLock(&rmPtr->lock);
if (rmPtr->lockcount == 0) {
Tcl_MutexUnlock(&rmPtr->lock);
return 0; /* Not locked now */
}
if (--rmPtr->lockcount <= 0) {
rmPtr->lockcount = 0;
rmPtr->owner = NULL;
if (rmPtr->cond) {
Tcl_ConditionNotify(&rmPtr->cond);
}
}
Tcl_MutexUnlock(&rmPtr->lock);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_RecursiveMutexFinalize --
*
* Finalize the recursive mutex. It is not safe for two or
* more threads to finalize the mutex at the same time.
*
* Results:
* None.
*
* Side effects:
* Mutex is destroyed.
*
*----------------------------------------------------------------------
*/
void
Sp_RecursiveMutexFinalize(Sp_RecursiveMutex *muxPtr)
{
if (*muxPtr != (Sp_RecursiveMutex_*)0) {
Sp_RecursiveMutex_ *rmPtr = *(Sp_RecursiveMutex_**)muxPtr;
if (rmPtr->lock) {
Tcl_MutexFinalize(&rmPtr->lock);
}
if (rmPtr->cond) {
Tcl_ConditionFinalize(&rmPtr->cond);
}
ckfree((char*)*muxPtr);
}
}
/*
*----------------------------------------------------------------------
*
* Sp_ReadWriteMutexRLock --
*
* Read-locks the reader/writer mutex.
*
* Results:
* 1 - mutex is locked
* 0 - mutex is not locked as we already hold the write lock
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_ReadWriteMutexRLock(Sp_ReadWriteMutex *muxPtr)
{
Sp_ReadWriteMutex_ *rwPtr;
Tcl_ThreadId thisThread = Tcl_GetCurrentThread();
/*
* Allocate the mutex structure on first access
*/
if (*muxPtr == (Sp_ReadWriteMutex_*)0) {
Tcl_MutexLock(&initMutex);
if (*muxPtr == (Sp_ReadWriteMutex_*)0) {
*muxPtr = (Sp_ReadWriteMutex_*)
ckalloc(sizeof(Sp_ReadWriteMutex_));
memset(*muxPtr, 0, sizeof(Sp_ReadWriteMutex_));
}
Tcl_MutexUnlock(&initMutex);
}
rwPtr = *(Sp_ReadWriteMutex_**)muxPtr;
Tcl_MutexLock(&rwPtr->lock);
if (rwPtr->lockcount == -1 && rwPtr->owner == thisThread) {
Tcl_MutexUnlock(&rwPtr->lock);
return 0; /* We already hold the write lock */
}
while (rwPtr->lockcount < 0) {
rwPtr->numrd++;
Tcl_ConditionWait(&rwPtr->rcond, &rwPtr->lock, NULL);
rwPtr->numrd--;
}
rwPtr->lockcount++;
rwPtr->owner = NULL; /* Many threads can read-lock */
Tcl_MutexUnlock(&rwPtr->lock);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_ReadWriteMutexWLock --
*
* Write-locks the reader/writer mutex.
*
* Results:
* 1 - mutex is locked
* 0 - same thread attempts to write-lock the mutex twice
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_ReadWriteMutexWLock(Sp_ReadWriteMutex *muxPtr)
{
Sp_ReadWriteMutex_ *rwPtr;
Tcl_ThreadId thisThread = Tcl_GetCurrentThread();
/*
* Allocate the mutex structure on first access
*/
if (*muxPtr == (Sp_ReadWriteMutex_*)0) {
Tcl_MutexLock(&initMutex);
if (*muxPtr == (Sp_ReadWriteMutex_*)0) {
*muxPtr = (Sp_ReadWriteMutex_*)
ckalloc(sizeof(Sp_ReadWriteMutex_));
memset(*muxPtr, 0, sizeof(Sp_ReadWriteMutex_));
}
Tcl_MutexUnlock(&initMutex);
}
rwPtr = *(Sp_ReadWriteMutex_**)muxPtr;
Tcl_MutexLock(&rwPtr->lock);
if (rwPtr->owner == thisThread && rwPtr->lockcount == -1) {
Tcl_MutexUnlock(&rwPtr->lock);
return 0; /* The same thread attempts to write-lock again */
}
while (rwPtr->lockcount != 0) {
rwPtr->numwr++;
Tcl_ConditionWait(&rwPtr->wcond, &rwPtr->lock, NULL);
rwPtr->numwr--;
}
rwPtr->lockcount = -1; /* This designates the sole writer */
rwPtr->owner = thisThread; /* which is our current thread */
Tcl_MutexUnlock(&rwPtr->lock);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_ReadWriteMutexIsLocked --
*
* Checks wether the mutex is locked or not.
*
* Results:
* 1 - mutex is locked
* 0 - mutex is not locked
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
int
Sp_ReadWriteMutexIsLocked(Sp_ReadWriteMutex *muxPtr)
{
return AnyMutexIsLocked((Sp_AnyMutex*)*muxPtr, NULL);
}
/*
*----------------------------------------------------------------------
*
* Sp_ReadWriteMutexUnlock --
*
* Unlock the reader/writer mutex.
*
* Results:
* None.
*
* Side effects:
*
*----------------------------------------------------------------------
*/
int
Sp_ReadWriteMutexUnlock(Sp_ReadWriteMutex *muxPtr)
{
Sp_ReadWriteMutex_ *rwPtr;
if (*muxPtr == (Sp_ReadWriteMutex_*)0) {
return 0; /* Never locked before */
}
rwPtr = *(Sp_ReadWriteMutex_**)muxPtr;
Tcl_MutexLock(&rwPtr->lock);
if (rwPtr->lockcount == 0) {
Tcl_MutexUnlock(&rwPtr->lock);
return 0; /* Not locked now */
}
if (--rwPtr->lockcount <= 0) {
rwPtr->lockcount = 0;
rwPtr->owner = NULL;
}
if (rwPtr->numwr) {
Tcl_ConditionNotify(&rwPtr->wcond);
} else if (rwPtr->numrd) {
Tcl_ConditionNotify(&rwPtr->rcond);
}
Tcl_MutexUnlock(&rwPtr->lock);
return 1;
}
/*
*----------------------------------------------------------------------
*
* Sp_ReadWriteMutexFinalize --
*
* Finalize the reader/writer mutex. It is not safe for two or
* more threads to finalize the mutex at the same time.
*
* Results:
* None.
*
* Side effects:
* Mutex is destroyed.
*
*----------------------------------------------------------------------
*/
void
Sp_ReadWriteMutexFinalize(Sp_ReadWriteMutex *muxPtr)
{
if (*muxPtr != (Sp_ReadWriteMutex_*)0) {
Sp_ReadWriteMutex_ *rwPtr = *(Sp_ReadWriteMutex_**)muxPtr;
if (rwPtr->lock) {
Tcl_MutexFinalize(&rwPtr->lock);
}
if (rwPtr->rcond) {
Tcl_ConditionFinalize(&rwPtr->rcond);
}
if (rwPtr->wcond) {
Tcl_ConditionFinalize(&rwPtr->wcond);
}
ckfree((char*)*muxPtr);
}
}
/*
*----------------------------------------------------------------------
*
* AnyMutexIsLocked --
*
* Checks wether the mutex is locked. If optional threadId
* is given (i.e. != 0) it checks if the given thread also
* holds the lock.
*
* Results:
* 1 - mutex is locked (optionally by the given thread)
* 0 - mutex is not locked (optionally by the given thread)
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
static int
AnyMutexIsLocked(Sp_AnyMutex *mPtr, Tcl_ThreadId threadId)
{
int locked = 0;
if (mPtr != NULL) {
Tcl_MutexLock(&mPtr->lock);
locked = mPtr->lockcount != 0;
if (locked && threadId != NULL) {
locked = mPtr->owner == threadId;
}
Tcl_MutexUnlock(&mPtr->lock);
}
return locked;
}
/* EOF $RCSfile: threadSpCmd.c,v $ */
/* Emacs Setup Variables */
/* Local Variables: */
/* mode: C */
/* indent-tabs-mode: nil */
/* c-basic-offset: 4 */
/* End: */