/*
* tclWinThread.c --
*
* This file implements the Windows-specific thread operations.
*
* Copyright © 1998 Sun Microsystems, Inc.
* Copyright © 1999 Scriptics Corporation
* Copyright © 2008 George Peter Staplin
*
* See the file "license.terms" for information on usage and redistribution of
* this file, and for a DISCLAIMER OF ALL WARRANTIES.
*/
#include "tclWinInt.h"
/* Workaround for mingw versions which don't provide this in float.h */
#ifndef _MCW_EM
# define _MCW_EM 0x0008001F /* Error masks */
# define _MCW_RC 0x00000300 /* Rounding */
# define _MCW_PC 0x00030000 /* Precision */
_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
#endif
static struct tclWinGlobals {
INIT_ONCE init_once; /* must be first member,
because of static initialziation */
/*
* This is the global lock used to serialize access to other serialization
* data structures.
*/
CRITICAL_SECTION globalLock;
/*
* This is the global lock used to serialize initialization and finalization
* of Tcl as a whole.
*/
CRITICAL_SECTION initLock;
/* holds the TLS key for the Tcl Thread_ID */
DWORD tls_thread_id;
/*
* allocLock is used by Tcl's version of malloc for synchronization. For
* obvious reasons, cannot use any dyamically allocated storage.
*/
#if TCL_THREADS
struct Tcl_Mutex_ {
CRITICAL_SECTION crit;
} allocLock;
Tcl_Mutex allocLockPtr;
#endif /* TCL_THREADS */
} TclWinGlobals = {
INIT_ONCE_STATIC_INIT
};
#if TCL_THREADS
typedef struct Tcl_Condition_ {
CONDITION_VARIABLE cv;
} WinCondition;
#endif /* TCL_THREADS */
/*
* The per thread data passed from TclpThreadCreate
* to TclWinThreadStart.
*/
typedef struct {
LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
LPVOID lpParameter; /* Original startup data */
unsigned int fpControl; /* Floating point control word from the
* main thread */
HANDLE tHandle; /* used to wait on thread completion */
# if defined(_MSC_VER) || defined(__MSVCRT__)
unsigned
# else
DWORD
# endif
thread_id; /* initialized but unused,
possibly useful for debugging */
} WinThread;
/* assuming alignment constraints result in lsb being constant 0 */
# define TCL_WIN_THREAD_JOIN_FLAG ((size_t) 1 << 0)
# define TCL_WIN_THREAD_ID(PTR, JOINABLE)\
((Tcl_ThreadId) ((sizeof ((PTR) - (WinThread *) 0),\
(size_t) (PTR)) | ((JOINABLE)? TCL_WIN_THREAD_JOIN_FLAG: 0)))
# define TCL_WIN_THREAD_PTR(ID)\
((WinThread *) ((sizeof ((ID) == (Tcl_ThreadId) 0),\
(size_t) (ID) & ~TCL_WIN_THREAD_JOIN_FLAG)))
# define TCL_WIN_THREAD_JOINABLE(ID)\
(((sizeof ((ID) == (Tcl_ThreadId) 0),\
(size_t) (ID) & TCL_WIN_THREAD_JOIN_FLAG)))
/*
*----------------------------------------------------------------------
*
* TclWinFailure --
*
* Call this when an unexpected WIN32 error occurs
*
* Does not return
*
*----------------------------------------------------------------------
*/
void TCL_NORETURN WINAPI
TclWinFailure (
char const *const routine)
{
Tcl_Panic ("%s failed, last error = %#x\n", routine, GetLastError ());
}
/*
*----------------------------------------------------------------------
*
* TclWinThreadStart --
*
* This procedure is the entry point for all new threads created
* by Tcl on Windows.
*
* Results:
* Various, depending on the result of the wrapped thread start
* routine.
*
* Side effects:
* Arbitrary, since user code is executed.
*
*----------------------------------------------------------------------
*/
static DWORD WINAPI
TclWinThreadStart(
LPVOID lpParameter) /* The WinThread structure pointer passed
* from TclpThreadCreate */
{
WinThread *const winThreadPtr = (WinThread *) lpParameter;
static DWORD result;
if (!winThreadPtr) {
return TCL_ERROR;
}
_controlfp(winThreadPtr->fpControl, _MCW_EM | _MCW_RC | 0x03000000 /* _MCW_DN */
#if !defined(_WIN64)
| _MCW_PC
#endif
);
if (!TlsSetValue (TclWinGlobals.tls_thread_id, winThreadPtr))
TclWinFailure ("TlsSetValue");
result = winThreadPtr->lpStartAddress (winThreadPtr->lpParameter);
if (!winThreadPtr->tHandle)
TclpSysFree (winThreadPtr);
return result;
}
/*
*----------------------------------------------------------------------
*
* 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(
Tcl_ThreadId *idPtr, /* Return, the ID of the thread. */
Tcl_ThreadCreateProc *proc, /* Main() function of the thread. */
void *clientData, /* The one argument to Main(). */
size_t stackSize, /* Size of stack for the new thread. */
int flags) /* Flags controlling behaviour of the new
* thread. */
{
WinThread *winThreadPtr; /* Per-thread startup info */
HANDLE tHandle;
winThreadPtr = (WinThread *) TclpSysAlloc (sizeof *winThreadPtr);
if (!winThreadPtr)
TclWinFailure ("memory allocation");
winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
winThreadPtr->lpParameter = clientData;
winThreadPtr->fpControl = _controlfp(0, 0);
#if defined(_MSC_VER) || defined(__MSVCRT__)
tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize,
(Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
0 /* flags */, &winThreadPtr->thread_id);
#else
tHandle = CreateThread(NULL, (DWORD) stackSize,
TclWinThreadStart, winThreadPtr, 0 /* flags */,
&winThreadPtr->thread_id);
#endif
if (!tHandle) {
TclpSysFree (winThreadPtr);
# if 1
TclWinFailure ("CreateThread");
# else
return TCL_ERROR;
# endif
} else {
if (!(flags & TCL_THREAD_JOINABLE)) {
/*
* The only purpose of this is to decrement the reference count
* so the OS resources will be reacquired when the thread closes.
*/
if (!CloseHandle (tHandle))
TclWinFailure ("ClosseHandle");
/* note: the WIN32 OpenHandle() can be used to open a HANDLE
from the given threadID. However, if the thread
terminates with a HANDLE count of zero, the kernel may clean up
the thread, in particular its return status, immediately.
Hence, joining the thread requires keeping a HANDLE open
until the thread has been successfully joined. */
tHandle = 0;
}
winThreadPtr->tHandle = tHandle;
*idPtr = TCL_WIN_THREAD_ID (winThreadPtr, 0 != tHandle);
return TCL_OK;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_JoinThread --
*
* This procedure waits upon the exit of the specified thread.
*
* Results:
* TCL_OK if the wait was successful, TCL_ERROR else.
*
* Side effects:
* The result area is set to the exit code of the thread we
* waited upon.
*
*----------------------------------------------------------------------
*/
int
Tcl_JoinThread(
Tcl_ThreadId threadId, /* Id of the thread to wait upon */
int *result) /* Reference to the storage the result of the
* thread we wait upon will be written into. */
{
if (!TCL_WIN_THREAD_JOINABLE (threadId))
return TCL_ERROR;
WinThread *winThreadPtr = TCL_WIN_THREAD_PTR (threadId);
HANDLE const tHandle = winThreadPtr->tHandle;
switch (WaitForSingleObject (tHandle, INFINITE)) {
DWORD exit_code;
default:
return TCL_ERROR;
case WAIT_FAILED:
TclWinFailure ("WaitForSingleObject");
case WAIT_OBJECT_0:
if (!GetExitCodeThread (tHandle, &exit_code))
TclWinFailure ("GetExitCodeThread");
*result = exit_code;
if (!CloseHandle (tHandle))
TclWinFailure ("CloseHandle");
TclpSysFree (winThreadPtr);
return TCL_OK;
}
}
/*
*----------------------------------------------------------------------
*
* TclpThreadExit --
*
* This procedure terminates the current thread.
*
* Results:
* None.
*
* Side effects:
* This procedure terminates the current thread.
*
*----------------------------------------------------------------------
*/
void
TclpThreadExit(
int status)
{
WinThread *winThreadPtr;
if (winThreadPtr = (WinThread *) TlsGetValue (
TclWinGlobals.tls_thread_id)) {
if (!winThreadPtr->tHandle)
TclpSysFree (winThreadPtr);
}
#if defined(_MSC_VER) || defined(__MSVCRT__)
_endthreadex((unsigned) status);
#else
ExitThread((DWORD) status);
#endif
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetCurrentThread --
*
* This procedure returns the ID of the currently running thread.
*
* Results:
* A thread ID.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
WinThread *winThreadPtr;
if (!(winThreadPtr = (WinThread *) TlsGetValue (
TclWinGlobals.tls_thread_id))) {
if (ERROR_SUCCESS != GetLastError ())
TclWinFailure ("TlsGetValue in Tcl_GetCurrentThread");
/* this is an initial thread */
/* can't use TclAlloc, as the USE_THREAD_ALLOC per-thread allocator
calls Tcl_GetCurrentThread() */
if (!(winThreadPtr = (WinThread *) TclpSysAlloc (sizeof *winThreadPtr)))
TclWinFailure ("memory allocation");
winThreadPtr->tHandle = 0;
winThreadPtr->thread_id = GetCurrentThreadId ();
if (!TlsSetValue (TclWinGlobals.tls_thread_id, winThreadPtr))
TclWinFailure ("TlsSetValue");
}
return TCL_WIN_THREAD_ID (winThreadPtr, 0 != winThreadPtr->tHandle);
}
/*
*----------------------------------------------------------------------
*
* TclWinInitOnce
*
* Perform module initialization exactly once
* storage keys.
*
* Results:
* None.
*
*
*----------------------------------------------------------------------
*/
static BOOL
TclWinInitOnce (
INIT_ONCE *init_once,
void *parameter,
void *context)
{
struct tclWinGlobals *const twg = parameter;
InitializeCriticalSection(&twg->initLock);
InitializeCriticalSection(&twg->globalLock);
twg->tls_thread_id = TlsAlloc ();
#if TCL_THREADS
InitializeCriticalSection(&twg->allocLock.crit);
twg->allocLockPtr = &twg->allocLock;
#endif /* TCL_THREADS */
return TRUE;
}
# define TCL_WIN_INITIALIZE_ONCE()\
InitOnceExecuteOnce (&TclWinGlobals.init_once,\
TclWinInitOnce,\
&TclWinGlobals,\
0)
/*
*----------------------------------------------------------------------
*
* 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(void)
{
if (!TCL_WIN_INITIALIZE_ONCE ())
TclWinFailure ("InitOnceExecuteOnce");
EnterCriticalSection(&TclWinGlobals.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(void)
{
LeaveCriticalSection(&TclWinGlobals.initLock);
}
/*
*----------------------------------------------------------------------
*
* TclpGlobalLock
*
* 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 synchronization objects.
*
* Results:
* None.
*
* Side effects:
* Acquire the global mutex.
*
*----------------------------------------------------------------------
*/
void
TclpGlobalLock(void)
{
if (!TCL_WIN_INITIALIZE_ONCE ())
TclWinFailure ("InitOnceExecuteOnce");
EnterCriticalSection(&TclWinGlobals.globalLock);
}
/*
*----------------------------------------------------------------------
*
* TclpGlobalUnlock
*
* This procedure is used to release a lock that serializes creation and
* deletion of synchronization objects.
*
* Results:
* None.
*
* Side effects:
* Release the global mutex.
*
*----------------------------------------------------------------------
*/
void
TclpGlobalUnlock(void)
{
LeaveCriticalSection(&TclWinGlobals.globalLock);
}
/*
*----------------------------------------------------------------------
*
* Tcl_GetAllocMutex
*
* This procedure returns a pointer to a statically initialized mutex for
* use by the memory allocator. The alloctor must use this lock, because
* all other locks are allocated...
*
* Results:
* A pointer to a mutex that is suitable for passing to Tcl_MutexLock and
* Tcl_MutexUnlock.
*
* Side effects:
* None.
*
*----------------------------------------------------------------------
*/
Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
if (!TCL_WIN_INITIALIZE_ONCE ())
TclWinFailure ("InitOnceExecuteOnce");
return &TclWinGlobals.allocLockPtr;
#else
return NULL;
#endif
}
/*
*----------------------------------------------------------------------
*
* TclFinalizeLock
*
* This procedure is used to destroy all private resources used in this
* file.
*
* Results:
* None.
*
* Side effects:
* Destroys everything private. TclpInitLock must be held entering this
* function.
*
*----------------------------------------------------------------------
*/
void
TclFinalizeLock(void)
{
struct tclWinGlobals *const twg = &TclWinGlobals;
TclpGlobalLock();
if (!TlsFree (twg->tls_thread_id))
TclWinFailure ("TlsFree");
/*
* Destroy the critical section that we are holding!
*/
DeleteCriticalSection(&twg->globalLock);
#if TCL_THREADS
DeleteCriticalSection(&twg->allocLock.crit);
#endif
LeaveCriticalSection(&twg->initLock);
/*
* Destroy the critical section that we were holding.
*/
DeleteCriticalSection(&twg->initLock);
InitOnceInitialize (&twg->init_once); /* assuming we want to
re-initialize at some point -- dubious */
}
#if TCL_THREADS
/*
*----------------------------------------------------------------------
*
* Tcl_MutexLock --
*
* This procedure is invoked to lock a mutex. This is a self initializing
* mutex that is automatically finalized during Tcl_Finalize.
*
* Results:
* None.
*
* Side effects:
* May block the current thread. The mutex is acquired when this returns.
*
*----------------------------------------------------------------------
*/
void
Tcl_MutexLock(
Tcl_Mutex *mutexPtr) /* The lock */
{
struct Tcl_Mutex_ *mp;
if (*mutexPtr == NULL) {
TclpGlobalLock();
/*
* Double inside global lock check to avoid a race.
* BROKEN: does work in relaxed memory models
*/
if (*mutexPtr == NULL) {
mp = Tcl_Alloc (sizeof *mp);
InitializeCriticalSection (&mp->crit);
*mutexPtr = mp;
TclRememberMutex(mutexPtr);
}
TclpGlobalUnlock();
}
EnterCriticalSection (&(*mutexPtr)->crit);
}
/*
*----------------------------------------------------------------------
*
* Tcl_MutexUnlock --
*
* This procedure is invoked to unlock a mutex.
*
* Results:
* None.
*
* Side effects:
* The mutex is released when this returns.
*
*----------------------------------------------------------------------
*/
void
Tcl_MutexUnlock(
Tcl_Mutex *mutexPtr) /* The lock */
{
LeaveCriticalSection (&(*mutexPtr)->crit);
}
/*
*----------------------------------------------------------------------
*
* 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(
Tcl_Mutex *mutexPtr)
{
if (*mutexPtr) {
DeleteCriticalSection(&(*mutexPtr)->crit);
Tcl_Free(*mutexPtr);
*mutexPtr = NULL;
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ConditionWait --
*
* This procedure is invoked to wait on a condition variable. The mutex
* is atomically 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 acquired when this returns.
* Will allocate memory for a HANDLE and initialize this the first time
* this Tcl_Condition is used.
*
*----------------------------------------------------------------------
*/
void
Tcl_ConditionWait(
Tcl_Condition *const condPtr,
Tcl_Mutex *const mutexPtr,
const Tcl_Time *timePtr) /* Timeout on waiting period */
{
/* BROKEN API: double-checked locking, which is broken, but needs changes
the Tcl C API to fix
"correct" double-checked locking needs an import memory barrier here */
if (*condPtr == NULL) {
TclpGlobalLock();
if (*condPtr == NULL) {
WinCondition *winCondPtr = Tcl_Alloc(sizeof *winCondPtr);
InitializeConditionVariable (&winCondPtr->cv);
*condPtr = winCondPtr;
TclRememberCondition (condPtr);
}
TclpGlobalUnlock();
}
/* mutexPtr is not checkd for lazy initialization,
but the caller is supposed to be holding it */
if (!SleepConditionVariableCS (&(*condPtr)->cv, &(*mutexPtr)->crit,
!timePtr? INFINITE: timePtr->sec * 1000 + timePtr->usec / 1000)) {
switch (GetLastError ()) {
default:
TclWinFailure ("SleepConditionVariableCS");
case ERROR_TIMEOUT:
/* the TCL Thread API does not report timeouts */
EnterCriticalSection (&(*mutexPtr)->crit);
}
}
}
/*
*----------------------------------------------------------------------
*
* Tcl_ConditionNotify --
*
* This procedure is invoked to signal a condition variable.
*
* The mutex does not need to be held during this call to avoid races
* and should not be, to minimize the number of context switches
*
* Results:
* None.
*
* Side effects:
* May unblock another thread.
*
*----------------------------------------------------------------------
*/
void
Tcl_ConditionNotify(
Tcl_Condition *condPtr)
{
/* double checked locking, i.e., BROKEN */
if (*condPtr == NULL) {
TclpGlobalLock();
if (*condPtr == NULL) {
WinCondition *winCondPtr;
winCondPtr = (WinCondition *)Tcl_Alloc(sizeof *winCondPtr);
InitializeConditionVariable (&winCondPtr->cv);
*condPtr = winCondPtr;
}
TclpGlobalUnlock();
}
WakeAllConditionVariable (&(*condPtr)->cv);
}
/*
*----------------------------------------------------------------------
*
* 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 Global Lock is held.
*
* Results:
* None.
*
* Side effects:
* The condition variable is deallocated.
*
*----------------------------------------------------------------------
*/
void
TclpFinalizeCondition(
Tcl_Condition *condPtr)
{
WinCondition *winCondPtr = *condPtr;
/*
* Note - this is called long after the thread-local storage is reclaimed.
* The per-thread condition waiting event is reclaimed earlier in a
* per-thread exit handler, which is called before thread local storage is
* reclaimed.
*/
if (winCondPtr != NULL) {
Tcl_Free(winCondPtr);
*condPtr = NULL;
}
}
/*
* Additions by AOL for specialized thread memory allocator.
*/
#ifdef USE_THREAD_ALLOC
static DWORD tlsKey;
typedef struct {
Tcl_Mutex tlock;
CRITICAL_SECTION wlock;
} allocMutex;
Tcl_Mutex *
TclpNewAllocMutex(void)
{
allocMutex *lockPtr;
lockPtr = (allocMutex *)malloc(sizeof(allocMutex));
if (lockPtr == NULL) {
Tcl_Panic("could not allocate lock");
}
lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
InitializeCriticalSection(&lockPtr->wlock);
return &lockPtr->tlock;
}
void
TclpFreeAllocMutex(
Tcl_Mutex *mutex) /* The alloc mutex to free. */
{
allocMutex *lockPtr = (allocMutex *) mutex;
if (!lockPtr) {
return;
}
DeleteCriticalSection(&lockPtr->wlock);
free(lockPtr);
}
void
TclpInitAllocCache(void)
{
/*
* We need to make sure that TclpFreeAllocCache is called on each
* thread that calls this, but only on threads that call this.
*/
tlsKey = TlsAlloc();
if (tlsKey == TLS_OUT_OF_INDEXES) {
Tcl_Panic("could not allocate thread local storage");
}
}
void *
TclpGetAllocCache(void)
{
void *result;
result = TlsGetValue(tlsKey);
if ((result == NULL) && (GetLastError() != NO_ERROR)) {
Tcl_Panic("TlsGetValue failed from TclpGetAllocCache");
}
return result;
}
void
TclpSetAllocCache(
void *ptr)
{
BOOL success;
success = TlsSetValue(tlsKey, ptr);
if (!success) {
Tcl_Panic("TlsSetValue failed from TclpSetAllocCache");
}
}
void
TclpFreeAllocCache(
void *ptr)
{
BOOL success;
if (ptr != NULL) {
/*
* Called by TclFinalizeThreadAlloc() and
* TclFinalizeThreadAllocThread() during Tcl_Finalize() or
* Tcl_FinalizeThread(). This function destroys the tsd key which
* stores allocator caches in thread local storage.
*/
TclFreeAllocCache(ptr);
success = TlsSetValue(tlsKey, NULL);
if (!success) {
Tcl_Panic("TlsSetValue failed from TclpFreeAllocCache");
}
} else {
/*
* Called by us in TclFinalizeThreadAlloc() during the library
* finalization initiated from Tcl_Finalize()
*/
success = TlsFree(tlsKey);
if (!success) {
Tcl_Panic("TlsFree failed from TclpFreeAllocCache");
}
}
}
#endif /* USE_THREAD_ALLOC */
void *
TclpThreadCreateKey(void)
{
DWORD *key;
key = (DWORD *)TclpSysAlloc(sizeof *key);
if (key == NULL) {
Tcl_Panic("unable to allocate thread key!");
}
*key = TlsAlloc();
if (*key == TLS_OUT_OF_INDEXES) {
Tcl_Panic("unable to allocate thread-local storage");
}
return key;
}
void
TclpThreadDeleteKey(
void *keyPtr)
{
DWORD *key = (DWORD *)keyPtr;
if (!TlsFree(*key)) {
Tcl_Panic("unable to delete key");
}
TclpSysFree(keyPtr);
}
void
TclpThreadSetGlobalTSD(
void *tsdKeyPtr,
void *ptr)
{
DWORD *key = (DWORD *)tsdKeyPtr;
if (!TlsSetValue(*key, ptr)) {
Tcl_Panic("unable to set global TSD value");
}
}
void *
TclpThreadGetGlobalTSD(
void *tsdKeyPtr)
{
DWORD *key = (DWORD *)tsdKeyPtr;
return TlsGetValue(*key);
}
#endif /* TCL_THREADS */
/*
* Local Variables:
* mode: c
* c-basic-offset: 4
* fill-column: 78
* End:
*/