sl@0: /* 
sl@0:  * tclWinThread.c --
sl@0:  *
sl@0:  *	This file implements the Windows-specific thread operations.
sl@0:  *
sl@0:  * Copyright (c) 1998 by Sun Microsystems, Inc.
sl@0:  * Copyright (c) 1999 by Scriptics Corporation
sl@0:  *
sl@0:  * See the file "license.terms" for information on usage and redistribution
sl@0:  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
sl@0:  *
sl@0:  * RCS: @(#) $Id: tclWinThrd.c,v 1.24.2.12 2007/03/24 09:31:11 vasiljevic Exp $
sl@0:  */
sl@0: 
sl@0: #include "tclWinInt.h"
sl@0: 
sl@0: #include <fcntl.h>
sl@0: #include <io.h>
sl@0: #include <sys/stat.h>
sl@0: 
sl@0: /*
sl@0:  * This is the master lock used to serialize access to other
sl@0:  * serialization data structures.
sl@0:  */
sl@0: 
sl@0: static CRITICAL_SECTION masterLock;
sl@0: static int init = 0;
sl@0: #define MASTER_LOCK TclpMasterLock() 
sl@0: #define MASTER_UNLOCK TclpMasterUnlock() 
sl@0: 
sl@0: 
sl@0: /*
sl@0:  * This is the master lock used to serialize initialization and finalization
sl@0:  * of Tcl as a whole.
sl@0:  */
sl@0: 
sl@0: static CRITICAL_SECTION initLock;
sl@0: 
sl@0: /*
sl@0:  * allocLock is used by Tcl's version of malloc for synchronization.
sl@0:  * For obvious reasons, cannot use any dyamically allocated storage.
sl@0:  */
sl@0: 
sl@0: #ifdef TCL_THREADS
sl@0: 
sl@0: static CRITICAL_SECTION allocLock;
sl@0: static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;
sl@0: static int allocOnce = 0;
sl@0: 
sl@0: #endif /* TCL_THREADS */
sl@0: 
sl@0: /*
sl@0:  * The joinLock serializes Create- and ExitThread. This is necessary to
sl@0:  * prevent a race where a new joinable thread exits before the creating
sl@0:  * thread had the time to create the necessary data structures in the
sl@0:  * emulation layer.
sl@0:  */
sl@0: 
sl@0: static CRITICAL_SECTION joinLock;
sl@0: 
sl@0: /*
sl@0:  * Condition variables are implemented with a combination of a 
sl@0:  * per-thread Windows Event and a per-condition waiting queue.
sl@0:  * The idea is that each thread has its own Event that it waits
sl@0:  * on when it is doing a ConditionWait; it uses the same event for
sl@0:  * all condition variables because it only waits on one at a time.
sl@0:  * Each condition variable has a queue of waiting threads, and a 
sl@0:  * mutex used to serialize access to this queue.
sl@0:  *
sl@0:  * Special thanks to David Nichols and
sl@0:  * Jim Davidson for advice on the Condition Variable implementation.
sl@0:  */
sl@0: 
sl@0: /*
sl@0:  * The per-thread event and queue pointers.
sl@0:  */
sl@0: 
sl@0: #ifdef TCL_THREADS
sl@0: 
sl@0: typedef struct ThreadSpecificData {
sl@0:     HANDLE condEvent;			/* Per-thread condition event */
sl@0:     struct ThreadSpecificData *nextPtr;	/* Queue pointers */
sl@0:     struct ThreadSpecificData *prevPtr;
sl@0:     int flags;				/* See flags below */
sl@0: } ThreadSpecificData;
sl@0: static Tcl_ThreadDataKey dataKey;
sl@0: 
sl@0: #endif /* TCL_THREADS */
sl@0: 
sl@0: /*
sl@0:  * Additions by AOL for specialized thread memory allocator.
sl@0:  */
sl@0: 
sl@0: #if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
sl@0: static int   once;
sl@0: static DWORD tlsKey;
sl@0: 
sl@0: typedef struct allocMutex {
sl@0:     Tcl_Mutex        tlock;
sl@0:     CRITICAL_SECTION wlock;
sl@0: } allocMutex;
sl@0: #endif
sl@0: 
sl@0: /*
sl@0:  * State bits for the thread.
sl@0:  * WIN_THREAD_UNINIT		Uninitialized.  Must be zero because
sl@0:  *				of the way ThreadSpecificData is created.
sl@0:  * WIN_THREAD_RUNNING		Running, not waiting.
sl@0:  * WIN_THREAD_BLOCKED		Waiting, or trying to wait.
sl@0:  */ 
sl@0: 
sl@0: #define WIN_THREAD_UNINIT	0x0
sl@0: #define WIN_THREAD_RUNNING	0x1
sl@0: #define WIN_THREAD_BLOCKED	0x2
sl@0: 
sl@0: /*
sl@0:  * The per condition queue pointers and the
sl@0:  * Mutex used to serialize access to the queue.
sl@0:  */
sl@0: 
sl@0: typedef struct WinCondition {
sl@0:     CRITICAL_SECTION condLock;	/* Lock to serialize queuing on the condition */
sl@0:     struct ThreadSpecificData *firstPtr;	/* Queue pointers */
sl@0:     struct ThreadSpecificData *lastPtr;
sl@0: } WinCondition;
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpThreadCreate --
sl@0:  *
sl@0:  *	This procedure creates a new thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	TCL_OK if the thread could be created.  The thread ID is
sl@0:  *	returned in a parameter.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	A new thread is created.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
sl@0:     Tcl_ThreadId *idPtr;		/* Return, the ID of the thread */
sl@0:     Tcl_ThreadCreateProc proc;		/* Main() function of the thread */
sl@0:     ClientData clientData;		/* The one argument to Main() */
sl@0:     int stackSize;			/* Size of stack for the new thread */
sl@0:     int flags;				/* Flags controlling behaviour of
sl@0: 					 * the new thread */
sl@0: {
sl@0:     HANDLE tHandle;
sl@0: 
sl@0:     EnterCriticalSection(&joinLock);
sl@0: 
sl@0: #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
sl@0:     tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
sl@0: 	clientData, 0, (unsigned *)idPtr);
sl@0: #else
sl@0:     tHandle = CreateThread(NULL, (DWORD) stackSize,
sl@0: 	    (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
sl@0: 	    (DWORD) 0, (LPDWORD)idPtr);
sl@0: #endif
sl@0: 
sl@0:     if (tHandle == NULL) {
sl@0:         LeaveCriticalSection(&joinLock);
sl@0: 	return TCL_ERROR;
sl@0:     } else {
sl@0:         if (flags & TCL_THREAD_JOINABLE) {
sl@0: 	    TclRememberJoinableThread (*idPtr);
sl@0: 	}
sl@0: 
sl@0: 	/*
sl@0: 	 * The only purpose of this is to decrement the reference count so the
sl@0: 	 * OS resources will be reaquired when the thread closes.
sl@0: 	 */
sl@0: 
sl@0: 	CloseHandle(tHandle);
sl@0: 	LeaveCriticalSection(&joinLock);
sl@0: 	return TCL_OK;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_JoinThread --
sl@0:  *
sl@0:  *	This procedure waits upon the exit of the specified thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	TCL_OK if the wait was successful, TCL_ERROR else.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The result area is set to the exit code of the thread we
sl@0:  *	waited upon.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: int
sl@0: Tcl_JoinThread(threadId, result)
sl@0:     Tcl_ThreadId threadId;  /* Id of the thread to wait upon */
sl@0:     int*     result;	    /* Reference to the storage the result
sl@0: 			     * of the thread we wait upon will be
sl@0: 			     * written into. */
sl@0: {
sl@0:     return TclJoinThread (threadId, result);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpThreadExit --
sl@0:  *
sl@0:  *	This procedure terminates the current thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	This procedure terminates the current thread.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpThreadExit(status)
sl@0:     int status;
sl@0: {
sl@0:     EnterCriticalSection(&joinLock);
sl@0:     TclSignalExitThread (Tcl_GetCurrentThread (), status);
sl@0:     LeaveCriticalSection(&joinLock);
sl@0: 
sl@0: #if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
sl@0:     _endthreadex((unsigned) status);
sl@0: #else
sl@0:     ExitThread((DWORD) status);
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_GetCurrentThread --
sl@0:  *
sl@0:  *	This procedure returns the ID of the currently running thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A thread ID.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_ThreadId
sl@0: Tcl_GetCurrentThread()
sl@0: {
sl@0:     return (Tcl_ThreadId)GetCurrentThreadId();
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpInitLock
sl@0:  *
sl@0:  *	This procedure is used to grab a lock that serializes initialization
sl@0:  *	and finalization of Tcl.  On some platforms this may also initialize
sl@0:  *	the mutex used to serialize creation of more mutexes and thread
sl@0:  *	local storage keys.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Acquire the initialization mutex.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpInitLock()
sl@0: {
sl@0:     if (!init) {
sl@0: 	/*
sl@0: 	 * There is a fundamental race here that is solved by creating
sl@0: 	 * the first Tcl interpreter in a single threaded environment.
sl@0: 	 * Once the interpreter has been created, it is safe to create
sl@0: 	 * more threads that create interpreters in parallel.
sl@0: 	 */
sl@0: 	init = 1;
sl@0: 	InitializeCriticalSection(&joinLock);
sl@0: 	InitializeCriticalSection(&initLock);
sl@0: 	InitializeCriticalSection(&masterLock);
sl@0:     }
sl@0:     EnterCriticalSection(&initLock);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpInitUnlock
sl@0:  *
sl@0:  *	This procedure is used to release a lock that serializes initialization
sl@0:  *	and finalization of Tcl.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Release the initialization mutex.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpInitUnlock()
sl@0: {
sl@0:     LeaveCriticalSection(&initLock);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpMasterLock
sl@0:  *
sl@0:  *	This procedure is used to grab a lock that serializes creation
sl@0:  *	of mutexes, condition variables, and thread local storage keys.
sl@0:  *
sl@0:  *	This lock must be different than the initLock because the
sl@0:  *	initLock is held during creation of syncronization objects.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Acquire the master mutex.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpMasterLock()
sl@0: {
sl@0:     if (!init) {
sl@0: 	/*
sl@0: 	 * There is a fundamental race here that is solved by creating
sl@0: 	 * the first Tcl interpreter in a single threaded environment.
sl@0: 	 * Once the interpreter has been created, it is safe to create
sl@0: 	 * more threads that create interpreters in parallel.
sl@0: 	 */
sl@0: 	init = 1;
sl@0: 	InitializeCriticalSection(&joinLock);
sl@0: 	InitializeCriticalSection(&initLock);
sl@0: 	InitializeCriticalSection(&masterLock);
sl@0:     }
sl@0:     EnterCriticalSection(&masterLock);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpMasterUnlock
sl@0:  *
sl@0:  *	This procedure is used to release a lock that serializes creation
sl@0:  *	and deletion of synchronization objects.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Release the master mutex.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpMasterUnlock()
sl@0: {
sl@0:     LeaveCriticalSection(&masterLock);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_GetAllocMutex
sl@0:  *
sl@0:  *	This procedure returns a pointer to a statically initialized
sl@0:  *	mutex for use by the memory allocator.  The alloctor must
sl@0:  *	use this lock, because all other locks are allocated...
sl@0:  *
sl@0:  * Results:
sl@0:  *	A pointer to a mutex that is suitable for passing to
sl@0:  *	Tcl_MutexLock and Tcl_MutexUnlock.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: Tcl_Mutex *
sl@0: Tcl_GetAllocMutex()
sl@0: {
sl@0: #ifdef TCL_THREADS
sl@0:     if (!allocOnce) {
sl@0: 	InitializeCriticalSection(&allocLock);
sl@0: 	allocOnce = 1;
sl@0:     }
sl@0:     return &allocLockPtr;
sl@0: #else
sl@0:     return NULL;
sl@0: #endif
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFinalizeLock
sl@0:  *
sl@0:  *	This procedure is used to destroy all private resources used in
sl@0:  *	this file.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Destroys everything private.  TclpInitLock must be held
sl@0:  *	entering this function.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclFinalizeLock ()
sl@0: {
sl@0:     MASTER_LOCK;
sl@0:     DeleteCriticalSection(&joinLock);
sl@0:     /* Destroy the critical section that we are holding! */
sl@0:     DeleteCriticalSection(&masterLock);
sl@0:     init = 0;
sl@0: #ifdef TCL_THREADS
sl@0:     DeleteCriticalSection(&allocLock);
sl@0:     allocOnce = 0;
sl@0: #endif
sl@0:     /* Destroy the critical section that we are holding! */
sl@0:     DeleteCriticalSection(&initLock);
sl@0: }
sl@0: 
sl@0: #ifdef TCL_THREADS
sl@0: 
sl@0: /* locally used prototype */
sl@0: static void FinalizeConditionEvent(ClientData data);
sl@0: 
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_MutexLock --
sl@0:  *
sl@0:  *	This procedure is invoked to lock a mutex.  This is a self 
sl@0:  *	initializing mutex that is automatically finalized during
sl@0:  *	Tcl_Finalize.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May block the current thread.  The mutex is aquired when
sl@0:  *	this returns.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_MutexLock(mutexPtr)
sl@0:     Tcl_Mutex *mutexPtr;	/* The lock */
sl@0: {
sl@0:     CRITICAL_SECTION *csPtr;
sl@0:     if (*mutexPtr == NULL) {
sl@0: 	MASTER_LOCK;
sl@0: 
sl@0: 	/* 
sl@0: 	 * Double inside master lock check to avoid a race.
sl@0: 	 */
sl@0: 
sl@0: 	if (*mutexPtr == NULL) {
sl@0: 	    csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
sl@0: 	    InitializeCriticalSection(csPtr);
sl@0: 	    *mutexPtr = (Tcl_Mutex)csPtr;
sl@0: 	    TclRememberMutex(mutexPtr);
sl@0: 	}
sl@0: 	MASTER_UNLOCK;
sl@0:     }
sl@0:     csPtr = *((CRITICAL_SECTION **)mutexPtr);
sl@0:     EnterCriticalSection(csPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_MutexUnlock --
sl@0:  *
sl@0:  *	This procedure is invoked to unlock a mutex.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The mutex is released when this returns.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_MutexUnlock(mutexPtr)
sl@0:     Tcl_Mutex *mutexPtr;	/* The lock */
sl@0: {
sl@0:     CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
sl@0:     LeaveCriticalSection(csPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFinalizeMutex --
sl@0:  *
sl@0:  *	This procedure is invoked to clean up one mutex.  This is only
sl@0:  *	safe to call at the end of time.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The mutex list is deallocated.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpFinalizeMutex(mutexPtr)
sl@0:     Tcl_Mutex *mutexPtr;
sl@0: {
sl@0:     CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
sl@0:     if (csPtr != NULL) {
sl@0: 	DeleteCriticalSection(csPtr);
sl@0: 	ckfree((char *)csPtr);
sl@0: 	*mutexPtr = NULL;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpThreadDataKeyInit --
sl@0:  *
sl@0:  *	This procedure initializes a thread specific data block key.
sl@0:  *	Each thread has table of pointers to thread specific data.
sl@0:  *	all threads agree on which table entry is used by each module.
sl@0:  *	this is remembered in a "data key", that is just an index into
sl@0:  *	this table.  To allow self initialization, the interface
sl@0:  *	passes a pointer to this key and the first thread to use
sl@0:  *	the key fills in the pointer to the key.  The key should be
sl@0:  *	a process-wide static.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Will allocate memory the first time this process calls for
sl@0:  *	this key.  In this case it modifies its argument
sl@0:  *	to hold the pointer to information about the key.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpThreadDataKeyInit(keyPtr)
sl@0:     Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
sl@0: 				 * really (DWORD **) */
sl@0: {
sl@0:     DWORD *indexPtr;
sl@0:     DWORD newKey;
sl@0: 
sl@0:     MASTER_LOCK;
sl@0:     if (*keyPtr == NULL) {
sl@0: 	indexPtr = (DWORD *)ckalloc(sizeof(DWORD));
sl@0: 	newKey = TlsAlloc();
sl@0:         if (newKey != TLS_OUT_OF_INDEXES) {
sl@0:             *indexPtr = newKey;
sl@0:         } else {
sl@0:             panic("TlsAlloc failed from TclpThreadDataKeyInit!"); /* this should be a fatal error */
sl@0:         }
sl@0: 	*keyPtr = (Tcl_ThreadDataKey)indexPtr;
sl@0: 	TclRememberDataKey(keyPtr);
sl@0:     }
sl@0:     MASTER_UNLOCK;
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpThreadDataKeyGet --
sl@0:  *
sl@0:  *	This procedure returns a pointer to a block of thread local storage.
sl@0:  *
sl@0:  * Results:
sl@0:  *	A thread-specific pointer to the data structure, or NULL
sl@0:  *	if the memory has not been assigned to this key for this thread.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	None.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: VOID *
sl@0: TclpThreadDataKeyGet(keyPtr)
sl@0:     Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
sl@0: 				 * really (DWORD **) */
sl@0: {
sl@0:     DWORD *indexPtr = *(DWORD **)keyPtr;
sl@0:     LPVOID result;
sl@0:     if (indexPtr == NULL) {
sl@0: 	return NULL;
sl@0:     } else {
sl@0:         result = TlsGetValue(*indexPtr);
sl@0:         if ((result == NULL) && (GetLastError() != NO_ERROR)) {
sl@0:             panic("TlsGetValue failed from TclpThreadDataKeyGet!");
sl@0:         }
sl@0: 	return result;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpThreadDataKeySet --
sl@0:  *
sl@0:  *	This procedure sets the pointer to a block of thread local storage.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Sets up the thread so future calls to TclpThreadDataKeyGet with
sl@0:  *	this key will return the data pointer.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpThreadDataKeySet(keyPtr, data)
sl@0:     Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
sl@0: 				 * really (pthread_key_t **) */
sl@0:     VOID *data;			/* Thread local storage */
sl@0: {
sl@0:     DWORD *indexPtr = *(DWORD **)keyPtr;
sl@0:     BOOL success;
sl@0:     success = TlsSetValue(*indexPtr, (void *)data);
sl@0:     if (!success) {
sl@0:         panic("TlsSetValue failed from TclpThreadDataKeySet!");
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFinalizeThreadData --
sl@0:  *
sl@0:  *	This procedure cleans up the thread-local storage.  This is
sl@0:  *	called once for each thread.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	Frees up the memory.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpFinalizeThreadData(keyPtr)
sl@0:     Tcl_ThreadDataKey *keyPtr;
sl@0: {
sl@0:     VOID *result;
sl@0:     DWORD *indexPtr;
sl@0:     BOOL success;
sl@0: 
sl@0:     if (*keyPtr != NULL) {
sl@0: 	indexPtr = *(DWORD **)keyPtr;
sl@0: 	result = (VOID *)TlsGetValue(*indexPtr);
sl@0: 	if (result != NULL) {
sl@0: #if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
sl@0: 	    if (indexPtr == &tlsKey) {
sl@0: 		TclpFreeAllocCache(result);
sl@0: 		return;
sl@0: 	    }
sl@0: #endif
sl@0: 	    ckfree((char *)result);
sl@0: 	    success = TlsSetValue(*indexPtr, (void *)NULL);
sl@0:             if (!success) {
sl@0:                 panic("TlsSetValue failed from TclpFinalizeThreadData!");
sl@0:             }
sl@0: 	} else {
sl@0:             if (GetLastError() != NO_ERROR) {
sl@0:                 panic("TlsGetValue failed from TclpFinalizeThreadData!");
sl@0:             }
sl@0: 	}
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFinalizeThreadDataKey --
sl@0:  *
sl@0:  *	This procedure is invoked to clean up one key.  This is a
sl@0:  *	process-wide storage identifier.  The thread finalization code
sl@0:  *	cleans up the thread local storage itself.
sl@0:  *
sl@0:  *	This assumes the master lock is held.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The key is deallocated.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpFinalizeThreadDataKey(keyPtr)
sl@0:     Tcl_ThreadDataKey *keyPtr;
sl@0: {
sl@0:     DWORD *indexPtr;
sl@0:     BOOL success;
sl@0:     if (*keyPtr != NULL) {
sl@0: 	indexPtr = *(DWORD **)keyPtr;
sl@0: 	success = TlsFree(*indexPtr);
sl@0:         if (!success) {
sl@0:             panic("TlsFree failed from TclpFinalizeThreadDataKey!");
sl@0:         }
sl@0: 	ckfree((char *)indexPtr);
sl@0: 	*keyPtr = NULL;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_ConditionWait --
sl@0:  *
sl@0:  *	This procedure is invoked to wait on a condition variable.
sl@0:  *	The mutex is atomically released as part of the wait, and
sl@0:  *	automatically grabbed when the condition is signaled.
sl@0:  *
sl@0:  *	The mutex must be held when this procedure is called.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May block the current thread.  The mutex is aquired when
sl@0:  *	this returns.  Will allocate memory for a HANDLE
sl@0:  *	and initialize this the first time this Tcl_Condition is used.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
sl@0:     Tcl_Condition *condPtr;	/* Really (WinCondition **) */
sl@0:     Tcl_Mutex *mutexPtr;	/* Really (CRITICAL_SECTION **) */
sl@0:     Tcl_Time *timePtr;		/* Timeout on waiting period */
sl@0: {
sl@0:     WinCondition *winCondPtr;	/* Per-condition queue head */
sl@0:     CRITICAL_SECTION *csPtr;	/* Caller's Mutex, after casting */
sl@0:     DWORD wtime;		/* Windows time value */
sl@0:     int timeout;		/* True if we got a timeout */
sl@0:     int doExit = 0;		/* True if we need to do exit setup */
sl@0:     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
sl@0: 
sl@0:     /*
sl@0:      * Self initialize the two parts of the condition.
sl@0:      * The per-condition and per-thread parts need to be
sl@0:      * handled independently.
sl@0:      */
sl@0: 
sl@0:     if (tsdPtr->flags == WIN_THREAD_UNINIT) {
sl@0: 	MASTER_LOCK;
sl@0: 
sl@0: 	/* 
sl@0: 	 * Create the per-thread event and queue pointers.
sl@0: 	 */
sl@0: 
sl@0: 	if (tsdPtr->flags == WIN_THREAD_UNINIT) {
sl@0: 	    tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */,
sl@0: 			FALSE /* non signaled */, NULL);
sl@0: 	    tsdPtr->nextPtr = NULL;
sl@0: 	    tsdPtr->prevPtr = NULL;
sl@0: 	    tsdPtr->flags = WIN_THREAD_RUNNING;
sl@0: 	    doExit = 1;
sl@0: 	}
sl@0: 	MASTER_UNLOCK;
sl@0: 
sl@0: 	if (doExit) {
sl@0: 	    /*
sl@0: 	     * Create a per-thread exit handler to clean up the condEvent.
sl@0: 	     * We must be careful to do this outside the Master Lock
sl@0: 	     * because Tcl_CreateThreadExitHandler uses its own
sl@0: 	     * ThreadSpecificData, and initializing that may drop
sl@0: 	     * back into the Master Lock.
sl@0: 	     */
sl@0: 	    
sl@0: 	    Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
sl@0: 		    (ClientData) tsdPtr);
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     if (*condPtr == NULL) {
sl@0: 	MASTER_LOCK;
sl@0: 
sl@0: 	/*
sl@0: 	 * Initialize the per-condition queue pointers and Mutex.
sl@0: 	 */
sl@0: 
sl@0: 	if (*condPtr == NULL) {
sl@0: 	    winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
sl@0: 	    InitializeCriticalSection(&winCondPtr->condLock);
sl@0: 	    winCondPtr->firstPtr = NULL;
sl@0: 	    winCondPtr->lastPtr = NULL;
sl@0: 	    *condPtr = (Tcl_Condition)winCondPtr;
sl@0: 	    TclRememberCondition(condPtr);
sl@0: 	}
sl@0: 	MASTER_UNLOCK;
sl@0:     }
sl@0:     csPtr = *((CRITICAL_SECTION **)mutexPtr);
sl@0:     winCondPtr = *((WinCondition **)condPtr);
sl@0:     if (timePtr == NULL) {
sl@0: 	wtime = INFINITE;
sl@0:     } else {
sl@0: 	wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Queue the thread on the condition, using
sl@0:      * the per-condition lock for serialization.
sl@0:      */
sl@0: 
sl@0:     tsdPtr->flags = WIN_THREAD_BLOCKED;
sl@0:     tsdPtr->nextPtr = NULL;
sl@0:     EnterCriticalSection(&winCondPtr->condLock);
sl@0:     tsdPtr->prevPtr = winCondPtr->lastPtr;		/* A: */
sl@0:     winCondPtr->lastPtr = tsdPtr;
sl@0:     if (tsdPtr->prevPtr != NULL) {
sl@0:         tsdPtr->prevPtr->nextPtr = tsdPtr;
sl@0:     }
sl@0:     if (winCondPtr->firstPtr == NULL) {
sl@0:         winCondPtr->firstPtr = tsdPtr;
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Unlock the caller's mutex and wait for the condition, or a timeout.
sl@0:      * There is a minor issue here in that we don't count down the
sl@0:      * timeout if we get notified, but another thread grabs the condition
sl@0:      * before we do.  In that race condition we'll wait again for the
sl@0:      * full timeout.  Timed waits are dubious anyway.  Either you have
sl@0:      * the locking protocol wrong and are masking a deadlock,
sl@0:      * or you are using conditions to pause your thread.
sl@0:      */
sl@0:     
sl@0:     LeaveCriticalSection(csPtr);
sl@0:     timeout = 0;
sl@0:     while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
sl@0: 	ResetEvent(tsdPtr->condEvent);
sl@0: 	LeaveCriticalSection(&winCondPtr->condLock);
sl@0: 	if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) {
sl@0: 	    timeout = 1;
sl@0: 	}
sl@0: 	EnterCriticalSection(&winCondPtr->condLock);
sl@0:     }
sl@0: 
sl@0:     /*
sl@0:      * Be careful on timeouts because the signal might arrive right around
sl@0:      * the time limit and someone else could have taken us off the queue.
sl@0:      */
sl@0:     
sl@0:     if (timeout) {
sl@0: 	if (tsdPtr->flags & WIN_THREAD_RUNNING) {
sl@0: 	    timeout = 0;
sl@0: 	} else {
sl@0: 	    /*
sl@0: 	     * When dequeuing, we can leave the tsdPtr->nextPtr
sl@0: 	     * and tsdPtr->prevPtr with dangling pointers because
sl@0: 	     * they are reinitialilzed w/out reading them when the
sl@0: 	     * thread is enqueued later.
sl@0: 	     */
sl@0: 
sl@0:             if (winCondPtr->firstPtr == tsdPtr) {
sl@0:                 winCondPtr->firstPtr = tsdPtr->nextPtr;
sl@0:             } else {
sl@0:                 tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
sl@0:             }
sl@0:             if (winCondPtr->lastPtr == tsdPtr) {
sl@0:                 winCondPtr->lastPtr = tsdPtr->prevPtr;
sl@0:             } else {
sl@0:                 tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
sl@0:             }
sl@0:             tsdPtr->flags = WIN_THREAD_RUNNING;
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     LeaveCriticalSection(&winCondPtr->condLock);
sl@0:     EnterCriticalSection(csPtr);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * Tcl_ConditionNotify --
sl@0:  *
sl@0:  *	This procedure is invoked to signal a condition variable.
sl@0:  *
sl@0:  *	The mutex must be held during this call to avoid races,
sl@0:  *	but this interface does not enforce that.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	May unblock another thread.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: Tcl_ConditionNotify(condPtr)
sl@0:     Tcl_Condition *condPtr;
sl@0: {
sl@0:     WinCondition *winCondPtr;
sl@0:     ThreadSpecificData *tsdPtr;
sl@0: 
sl@0:     if (condPtr != NULL) {
sl@0: 	winCondPtr = *((WinCondition **)condPtr);
sl@0: 
sl@0: 	if (winCondPtr == NULL) {
sl@0: 	    return;
sl@0: 	}
sl@0: 
sl@0: 	/*
sl@0: 	 * Loop through all the threads waiting on the condition
sl@0: 	 * and notify them (i.e., broadcast semantics).  The queue
sl@0: 	 * manipulation is guarded by the per-condition coordinating mutex.
sl@0: 	 */
sl@0: 
sl@0: 	EnterCriticalSection(&winCondPtr->condLock);
sl@0: 	while (winCondPtr->firstPtr != NULL) {
sl@0: 	    tsdPtr = winCondPtr->firstPtr;
sl@0: 	    winCondPtr->firstPtr = tsdPtr->nextPtr;
sl@0: 	    if (winCondPtr->lastPtr == tsdPtr) {
sl@0: 		winCondPtr->lastPtr = NULL;
sl@0: 	    }
sl@0: 	    tsdPtr->flags = WIN_THREAD_RUNNING;
sl@0: 	    tsdPtr->nextPtr = NULL;
sl@0: 	    tsdPtr->prevPtr = NULL;	/* Not strictly necessary, see A: */
sl@0: 	    SetEvent(tsdPtr->condEvent);
sl@0: 	}
sl@0: 	LeaveCriticalSection(&winCondPtr->condLock);
sl@0:     } else {
sl@0: 	/*
sl@0: 	 * Noone has used the condition variable, so there are no waiters.
sl@0: 	 */
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * FinalizeConditionEvent --
sl@0:  *
sl@0:  *	This procedure is invoked to clean up the per-thread
sl@0:  *	event used to implement condition waiting.
sl@0:  *	This is only safe to call at the end of time.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The per-thread event is closed.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: static void
sl@0: FinalizeConditionEvent(data)
sl@0:     ClientData data;
sl@0: {
sl@0:     ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
sl@0:     tsdPtr->flags = WIN_THREAD_UNINIT;
sl@0:     CloseHandle(tsdPtr->condEvent);
sl@0: }
sl@0: 
sl@0: /*
sl@0:  *----------------------------------------------------------------------
sl@0:  *
sl@0:  * TclpFinalizeCondition --
sl@0:  *
sl@0:  *	This procedure is invoked to clean up a condition variable.
sl@0:  *	This is only safe to call at the end of time.
sl@0:  *
sl@0:  *	This assumes the Master Lock is held.
sl@0:  *
sl@0:  * Results:
sl@0:  *	None.
sl@0:  *
sl@0:  * Side effects:
sl@0:  *	The condition variable is deallocated.
sl@0:  *
sl@0:  *----------------------------------------------------------------------
sl@0:  */
sl@0: 
sl@0: void
sl@0: TclpFinalizeCondition(condPtr)
sl@0:     Tcl_Condition *condPtr;
sl@0: {
sl@0:     WinCondition *winCondPtr = *(WinCondition **)condPtr;
sl@0: 
sl@0:     /*
sl@0:      * Note - this is called long after the thread-local storage is
sl@0:      * reclaimed.  The per-thread condition waiting event is
sl@0:      * reclaimed earlier in a per-thread exit handler, which is
sl@0:      * called before thread local storage is reclaimed.
sl@0:      */
sl@0: 
sl@0:     if (winCondPtr != NULL) {
sl@0: 	DeleteCriticalSection(&winCondPtr->condLock);
sl@0: 	ckfree((char *)winCondPtr);
sl@0: 	*condPtr = NULL;
sl@0:     }
sl@0: }
sl@0: 
sl@0: /*
sl@0:  * Additions by AOL for specialized thread memory allocator.
sl@0:  */
sl@0: 
sl@0: #if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
sl@0: Tcl_Mutex *
sl@0: TclpNewAllocMutex(void)
sl@0: {
sl@0:     struct allocMutex *lockPtr;
sl@0: 
sl@0:     lockPtr = malloc(sizeof(struct allocMutex));
sl@0:     if (lockPtr == NULL) {
sl@0: 	panic("could not allocate lock");
sl@0:     }
sl@0:     lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
sl@0:     InitializeCriticalSection(&lockPtr->wlock);
sl@0:     return &lockPtr->tlock;
sl@0: }
sl@0: 
sl@0: void
sl@0: TclpFreeAllocMutex(mutex)
sl@0:     Tcl_Mutex *mutex; /* The alloc mutex to free. */
sl@0: {
sl@0:     allocMutex* lockPtr = (allocMutex*) mutex;
sl@0:     if (!lockPtr) return;
sl@0:     DeleteCriticalSection(&lockPtr->wlock);
sl@0:     free(lockPtr);
sl@0: }
sl@0: 
sl@0: void *
sl@0: TclpGetAllocCache(void)
sl@0: {
sl@0:     VOID *result;
sl@0: 
sl@0:     if (!once) {
sl@0: 	/*
sl@0: 	 * We need to make sure that TclpFreeAllocCache is called
sl@0: 	 * on each thread that calls this, but only on threads that
sl@0: 	 * call this.
sl@0: 	 */
sl@0:     	tlsKey = TlsAlloc();
sl@0: 	once = 1;
sl@0: 	if (tlsKey == TLS_OUT_OF_INDEXES) {
sl@0: 	    panic("could not allocate thread local storage");
sl@0: 	}
sl@0:     }
sl@0: 
sl@0:     result = TlsGetValue(tlsKey);
sl@0:     if ((result == NULL) && (GetLastError() != NO_ERROR)) {
sl@0:         panic("TlsGetValue failed from TclpGetAllocCache!");
sl@0:     }
sl@0:     return result;
sl@0: }
sl@0: 
sl@0: void
sl@0: TclpSetAllocCache(void *ptr)
sl@0: {
sl@0:     BOOL success;
sl@0:     success = TlsSetValue(tlsKey, ptr);
sl@0:     if (!success) {
sl@0:         panic("TlsSetValue failed from TclpSetAllocCache!");
sl@0:     }
sl@0: }
sl@0: 
sl@0: void
sl@0: TclpFreeAllocCache(void *ptr)
sl@0: {
sl@0:     BOOL success;
sl@0: 
sl@0:     if (ptr != NULL) {
sl@0:         /*
sl@0:          * Called by the pthread lib when a thread exits
sl@0:          */
sl@0:         TclFreeAllocCache(ptr);
sl@0:         success = TlsSetValue(tlsKey, NULL);
sl@0:         if (!success) {
sl@0:             panic("TlsSetValue failed from TclpFreeAllocCache!");
sl@0:         }
sl@0:     } else if (once) { 
sl@0:         /*
sl@0:          * Called by us in TclFinalizeThreadAlloc() during
sl@0:          * the library finalization initiated from Tcl_Finalize()
sl@0:          */
sl@0:         success = TlsFree(tlsKey);
sl@0:         if (!success) {
sl@0:             Tcl_Panic("TlsFree failed from TclpFreeAllocCache!");
sl@0:         }
sl@0:         once = 0; /* reset for next time. */
sl@0:     }
sl@0: }
sl@0: 
sl@0: #endif /* USE_THREAD_ALLOC */
sl@0: #endif /* TCL_THREADS */