1935 lines
49 KiB
C
1935 lines
49 KiB
C
/*
|
||
* 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: */
|