/*
* tclWinThread.c --
*
* This file implements the Windows-specific thread operations.
*
* Copyright (c) 1998 by Sun Microsystems, Inc.
*
* See the file "license.terms" for information on usage and redistribution
* of this file, and for a DISCLAIMER OF ALL WARRANTIES.
*
* SCCS: @(#) tclWinThrd.c 1.13 98/02/18 14:00:23
*/
#include "tclWinInt.h"
#include <dos.h>
#include <fcntl.h>
#include <io.h>
#include <sys/stat.h>
/*
* This is the master lock used to serialize access to other
* serialization data structures.
*/
static CRITICAL_SECTION masterLock;
static int init = 0;
#define MASTER_LOCK EnterCriticalSection(&masterLock)
#define MASTER_UNLOCK LeaveCriticalSection(&masterLock)
/*
* This is the master lock used to serialize initialization and finalization
* of Tcl as a whole.
*/
static CRITICAL_SECTION initLock;
/*
* This is a preallocated lock for use by memory allocators.
*/
static CRITICAL_SECTION allocLock;
TCL_DECLARE_MUTEX(allocMutex)
/*
*----------------------------------------------------------------------
*
* TclpThreadCreate --
*
* This procedure creates a new thread.
*
* Results:
* TCL_OK if the thread could be created. The thread ID is
* returned in a parameter.
*
* Side effects:
* A new thread is created.
*
*----------------------------------------------------------------------
*/
int
TclpThreadCreate(idPtr, proc, clientData)
Tcl_ThreadId *idPtr; /* Return, the ID of the thread */
Tcl_ThreadCreateProc proc; /* Main() function of the thread */
ClientData clientData; /* The one argument to Main() */
{
HANDLE tHandle;
tHandle = CreateThread(NULL, 0, (LPTHREAD_START_ROUTINE) proc,
(DWORD *)clientData, 0, (DWORD *)idPtr);
if (tHandle == NULL) {
return TCL_ERROR;
} else {
return TCL_OK;
}
}
/*
*----------------------------------------------------------------------
*
* TclpThreadExit --
*
* This procedure terminates the current thread.
*
* Results:
* None.
*
* Side effects:
* This procedure terminates the current thread.
*
*----------------------------------------------------------------------
*/
void
TclpThreadExit(status)
int status;
{
ExitThread((DWORD)status);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetCurrentThread --
*
* This procedure returns the ID of the currently running thread.
*
* Results:
* A thread ID.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_ThreadId
Tcl_GetCurrentThread()
{
return (Tcl_ThreadId)GetCurrentThreadId();
}
/*
*----------------------------------------------------------------------
*
* TclpInitLock
*
* This procedure is used to grab a lock that serializes initialization
* and finalization of Tcl. On some platforms this may also initialize
* the mutex used to serialize creation of more mutexes and thread
* local storage keys.
*
* Results:
* None.
*
* Side effects:
* Acquire the initialization mutex.
*
*----------------------------------------------------------------------
*/
void
TclpInitLock()
{
if (!init) {
/*
* There is a fundamental race here that is solved by creating
* the first Tcl interpreter in a single threaded environment.
* Once the interpreter has been created, it is safe to create
* more threads that create interpreters in parallel.
*/
init = 1;
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
}
EnterCriticalSection(&initLock);
}
/*
*----------------------------------------------------------------------
*
* TclpInitUnlock
*
* This procedure is used to release a lock that serializes initialization
* and finalization of Tcl.
*
* Results:
* None.
*
* Side effects:
* Release the initialization mutex.
*
*----------------------------------------------------------------------
*/
void
TclpInitUnlock()
{
LeaveCriticalSection(&initLock);
}
/*
*----------------------------------------------------------------------
*
* TclpMasterLock
*
* This procedure is used to grab a lock that serializes creation
* of mutexes, condition variables, and thread local storage keys.
*
* This lock must be different than the initLock because the
* initLock is held during creation of syncronization objects.
*
* Results:
* None.
*
* Side effects:
* Acquire the master mutex.
*
*----------------------------------------------------------------------
*/
void
TclpMasterLock()
{
if (!init) {
/*
* There is a fundamental race here that is solved by creating
* the first Tcl interpreter in a single threaded environment.
* Once the interpreter has been created, it is safe to create
* more threads that create interpreters in parallel.
*/
init = 1;
InitializeCriticalSection(&initLock);
InitializeCriticalSection(&masterLock);
}
EnterCriticalSection(&masterLock);
}
/*
*----------------------------------------------------------------------
*
* TclpMasterUnlock
*
* This procedure is used to release a lock that serializes creation
* and deletion of synchronization objects.
*
* Results:
* None.
*
* Side effects:
* Release the master mutex.
*
*----------------------------------------------------------------------
*/
void
TclpMasterUnlock()
{
LeaveCriticalSection(&masterLock);
}
#ifdef TCL_THREADS
/*
*----------------------------------------------------------------------
*
* TclpMutexInit --
* TclpMutexLock --
* TclpMutexUnlock --
*
* These procedures use an explicitly initialized mutex.
* These are used by memory allocators for their own mutex.
*
* Results:
* None.
*
* Side effects:
* Initialize, Lock, and Unlock the mutex.
*
*----------------------------------------------------------------------
*/
void
TclpMutexInit(mPtr)
TclpMutex *mPtr;
{
InitializeCriticalSection((CRITICAL_SECTION *)mPtr);
}
void
TclpMutexLock(mPtr)
TclpMutex *mPtr;
{
EnterCriticalSection((CRITICAL_SECTION *)mPtr);
}
void
TclpMutexUnlock(mPtr)
TclpMutex *mPtr;
{
LeaveCriticalSection((CRITICAL_SECTION *)mPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_MutexLock --
*
* This procedure is invoked to lock a mutex. This is a self
* initializing mutex that is automatically finalized during
* Tcl_Finalization.
*
* Results:
* None.
*
* Side effects:
* May block the current thread. The mutex is aquired when
* this returns.
*
*----------------------------------------------------------------------
*/
void
Tcl_MutexLock(mutexPtr)
Tcl_Mutex *mutexPtr; /* The lock */
{
CRITICAL_SECTION *csPtr;
if (*mutexPtr == NULL) {
MASTER_LOCK;
/*
* Double inside master lock check to avoid a race.
*/
if (*mutexPtr == NULL) {
csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
InitializeCriticalSection(csPtr);
*mutexPtr = (Tcl_Mutex)csPtr;
TclRememberMutex(mutexPtr);
}
MASTER_UNLOCK;
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
EnterCriticalSection(csPtr);
}
/*
*----------------------------------------------------------------------
*
* Tcl_MutexUnlock --
*
* This procedure is invoked to unlock a mutex.
*
* Results:
* None.
*
* Side effects:
* The mutex is released when this returns.
*
*----------------------------------------------------------------------
*/
void
Tcl_MutexUnlock(mutexPtr)
Tcl_Mutex *mutexPtr; /* The lock */
{
CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
LeaveCriticalSection(csPtr);
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeMutex --
*
* This procedure is invoked to clean up one mutex. This is only
* safe to call at the end of time.
*
* Results:
* None.
*
* Side effects:
* The mutex list is deallocated.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeMutex(mutexPtr)
Tcl_Mutex *mutexPtr;
{
CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
if (csPtr != NULL) {
ckfree((char *)csPtr);
*mutexPtr = NULL;
}
}
/*
*----------------------------------------------------------------------
*
* TclpThreadDataKeyInit --
*
* This procedure initializes a thread specific data block key.
* Each thread has table of pointers to thread specific data.
* all threads agree on which table entry is used by each module.
* this is remembered in a "data key", that is just an index into
* this table. To allow self initialization, the interface
* passes a pointer to this key and the first thread to use
* the key fills in the pointer to the key. The key should be
* a process-wide static.
*
* Results:
* None.
*
* Side effects:
* Will allocate memory the first time this process calls for
* this key. In this case it modifies its argument
* to hold the pointer to information about the key.
*
*----------------------------------------------------------------------
*/
void
TclpThreadDataKeyInit(keyPtr)
Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
* really (pthread_key_t **) */
{
DWORD *indexPtr;
MASTER_LOCK;
if (*keyPtr == NULL) {
indexPtr = (DWORD *)ckalloc(sizeof(DWORD));
*indexPtr = TlsAlloc();
*keyPtr = (Tcl_ThreadDataKey)indexPtr;
TclRememberDataKey(keyPtr);
}
MASTER_UNLOCK;
}
/*
*----------------------------------------------------------------------
*
* TclpThreadDataKeyGet --
*
* This procedure returns a pointer to a block of thread local storage.
*
* Results:
* A thread-specific pointer to the data structure, or NULL
* if the memory has not been assigned to this key for this thread.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
VOID *
TclpThreadDataKeyGet(keyPtr)
Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
* really (DWORD **) */
{
DWORD *indexPtr = *(DWORD **)keyPtr;
if (indexPtr == NULL) {
return NULL;
} else {
return (VOID *) TlsGetValue(*indexPtr);
}
}
/*
*----------------------------------------------------------------------
*
* TclpThreadDataKeySet --
*
* This procedure sets the pointer to a block of thread local storage.
*
* Results:
* None.
*
* Side effects:
* Sets up the thread so future calls to TclpThreadDataKeyGet with
* this key will return the data pointer.
*
*----------------------------------------------------------------------
*/
void
TclpThreadDataKeySet(keyPtr, data)
Tcl_ThreadDataKey *keyPtr; /* Identifier for the data chunk,
* really (pthread_key_t **) */
VOID *data; /* Thread local storage */
{
DWORD *indexPtr = *(DWORD **)keyPtr;
TlsSetValue(*indexPtr, (void *)data);
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeThreadData --
*
* This procedure cleans up the thread-local storage. This is
* called once for each thread.
*
* Results:
* None.
*
* Side effects:
* Frees up the memory.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeThreadData(keyPtr)
Tcl_ThreadDataKey *keyPtr;
{
VOID *result;
DWORD *indexPtr;
if (*keyPtr != NULL) {
indexPtr = *(DWORD **)keyPtr;
result = (VOID *)TlsGetValue(*indexPtr);
if (result != NULL) {
ckfree((char *)result);
TlsSetValue(*indexPtr, (void *)NULL);
}
}
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeThreadDataKey --
*
* This procedure is invoked to clean up one key. This is a
* process-wide storage identifier. The thread finalization code
* cleans up the thread local storage itself.
*
* This assumes the master lock is held.
*
* Results:
* None.
*
* Side effects:
* The key is deallocated.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeThreadDataKey(keyPtr)
Tcl_ThreadDataKey *keyPtr;
{
DWORD *indexPtr;
if (*keyPtr != NULL) {
indexPtr = *(DWORD **)keyPtr;
TlsFree(*indexPtr);
ckfree((char *)indexPtr);
*keyPtr = NULL;
}
}
/*
*----------------------------------------------------------------------
*
* TclpConditionWait --
*
* This procedure is invoked to wait on a condition variable.
* The mutex is automically released as part of the wait, and
* automatically grabbed when the condition is signaled.
*
* The mutex must be held when this procedure is called.
*
* Results:
* None.
*
* Side effects:
* May block the current thread. The mutex is aquired when
* this returns. Will allocate memory for a HANDLE
* and initialize this the first time this Tcl_Condition is used.
*
*----------------------------------------------------------------------
*/
void
TclpConditionWait(condPtr, mutexPtr, timePtr)
Tcl_Condition *condPtr; /* Really (pthread_cond_t **) */
Tcl_Mutex *mutexPtr; /* Really (pthread_mutex_t **) */
Tcl_Time *timePtr; /* Timeout on waiting period */
{
HANDLE *eventPtr;
CRITICAL_SECTION *csPtr;
DWORD wtime;
if (*condPtr == NULL) {
MASTER_LOCK;
/*
* Double check inside mutex to avoid race,
* then initialize condition variable if necessary.
*/
if (*condPtr == NULL) {
eventPtr = (HANDLE *)ckalloc(sizeof(HANDLE));
*eventPtr = CreateEvent(NULL, TRUE /* manual reset */,
FALSE /* non signaled */, NULL);
*condPtr = (Tcl_Condition)eventPtr;
TclRememberCondition(condPtr);
}
MASTER_UNLOCK;
}
csPtr = *((CRITICAL_SECTION **)mutexPtr);
eventPtr = *((HANDLE **)condPtr);
if (timePtr == NULL) {
wtime = INFINITE;
} else {
wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
}
/*
* Clear the event it case there are old notifies.
*/
ResetEvent(*eventPtr);
LeaveCriticalSection(csPtr);
/*
* This point is a race with a notification, but this is handled
* by the "stickiness" of the event. If a notification occurs here,
* then WaitForSingleObject will not block.
*/
WaitForSingleObject(*eventPtr, wtime);
/*
* This point is a race with other waiters. Someone else can grab
* the mutex first. This is why our caller must check its invariant
* and perhaps wait again.
*/
EnterCriticalSection(csPtr);
/*
* "Consume" the event - hmm - this may not be necessary because it
* will be done before the next wait.
*/
ResetEvent(*eventPtr);
}
/*
*----------------------------------------------------------------------
*
* TclpConditionNotify --
*
* This procedure is invoked to signal a condition variable.
*
* The mutex must be held during this call to avoid races,
* but this interface does not enforce that.
*
* Results:
* None.
*
* Side effects:
* May unblock another thread.
*
*----------------------------------------------------------------------
*/
void
TclpConditionNotify(condPtr)
Tcl_Condition *condPtr;
{
HANDLE *eventPtr;
if (condPtr != NULL) {
eventPtr = *((HANDLE **)condPtr);
/*
* The PulseEvent may not be necessary, but it's documentation says
* it releases all waiting processes, which is what we want. However,
* it also clears the signal, which is not good because of the race
* in ConditionWait. The SetEvent makes sure the signal remains
* even if there are no waiters, but we are not sure that it really
* marks all waiters as runnable. So we do both.
*/
PulseEvent(*eventPtr);
SetEvent(*eventPtr);
} else {
/*
* Noone has used the condition variable, so there are no waiters.
*/
}
}
/*
*----------------------------------------------------------------------
*
* TclpFinalizeCondition --
*
* This procedure is invoked to clean up a condition variable.
* This is only safe to call at the end of time.
*
* This assumes the Master Lock is held.
*
* Results:
* None.
*
* Side effects:
* The condition variable is deallocated.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeCondition(condPtr)
Tcl_Condition *condPtr;
{
HANDLE *eventPtr = *(HANDLE **)condPtr;
if (eventPtr != NULL) {
CloseHandle(*eventPtr);
ckfree((char *)eventPtr);
*condPtr = NULL;
}
}
#endif TCL_THREADS
Documentation