diff options
author | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
---|---|---|
committer | stanton <stanton> | 1998-09-21 23:39:52 (GMT) |
commit | 494c2de3a748b449c69ce322a1a741f5a31fd4d5 (patch) | |
tree | c3ece48c0ae3f4ba54787e0e8e729b65752ef3f9 /win/tclWinThrd.c | |
parent | 7a698c0488d99c0af42022714638ae1ba2afaa49 (diff) | |
download | tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.zip tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.gz tcl-494c2de3a748b449c69ce322a1a741f5a31fd4d5.tar.bz2 |
Added contents of Tcl 8.1a2
Diffstat (limited to 'win/tclWinThrd.c')
-rw-r--r-- | win/tclWinThrd.c | 724 |
1 files changed, 724 insertions, 0 deletions
diff --git a/win/tclWinThrd.c b/win/tclWinThrd.c new file mode 100644 index 0000000..f455d54 --- /dev/null +++ b/win/tclWinThrd.c @@ -0,0 +1,724 @@ +/* + * 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; +static Tcl_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 + + |