os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinThrd.c
changeset 0 bde4ae8d615e
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/os/persistentdata/persistentstorage/sqlite3api/TEST/TCL/tcldistribution/win/tclWinThrd.c	Fri Jun 15 03:10:57 2012 +0200
     1.3 @@ -0,0 +1,1141 @@
     1.4 +/* 
     1.5 + * tclWinThread.c --
     1.6 + *
     1.7 + *	This file implements the Windows-specific thread operations.
     1.8 + *
     1.9 + * Copyright (c) 1998 by Sun Microsystems, Inc.
    1.10 + * Copyright (c) 1999 by Scriptics Corporation
    1.11 + *
    1.12 + * See the file "license.terms" for information on usage and redistribution
    1.13 + * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
    1.14 + *
    1.15 + * RCS: @(#) $Id: tclWinThrd.c,v 1.24.2.12 2007/03/24 09:31:11 vasiljevic Exp $
    1.16 + */
    1.17 +
    1.18 +#include "tclWinInt.h"
    1.19 +
    1.20 +#include <fcntl.h>
    1.21 +#include <io.h>
    1.22 +#include <sys/stat.h>
    1.23 +
    1.24 +/*
    1.25 + * This is the master lock used to serialize access to other
    1.26 + * serialization data structures.
    1.27 + */
    1.28 +
    1.29 +static CRITICAL_SECTION masterLock;
    1.30 +static int init = 0;
    1.31 +#define MASTER_LOCK TclpMasterLock() 
    1.32 +#define MASTER_UNLOCK TclpMasterUnlock() 
    1.33 +
    1.34 +
    1.35 +/*
    1.36 + * This is the master lock used to serialize initialization and finalization
    1.37 + * of Tcl as a whole.
    1.38 + */
    1.39 +
    1.40 +static CRITICAL_SECTION initLock;
    1.41 +
    1.42 +/*
    1.43 + * allocLock is used by Tcl's version of malloc for synchronization.
    1.44 + * For obvious reasons, cannot use any dyamically allocated storage.
    1.45 + */
    1.46 +
    1.47 +#ifdef TCL_THREADS
    1.48 +
    1.49 +static CRITICAL_SECTION allocLock;
    1.50 +static Tcl_Mutex allocLockPtr = (Tcl_Mutex) &allocLock;
    1.51 +static int allocOnce = 0;
    1.52 +
    1.53 +#endif /* TCL_THREADS */
    1.54 +
    1.55 +/*
    1.56 + * The joinLock serializes Create- and ExitThread. This is necessary to
    1.57 + * prevent a race where a new joinable thread exits before the creating
    1.58 + * thread had the time to create the necessary data structures in the
    1.59 + * emulation layer.
    1.60 + */
    1.61 +
    1.62 +static CRITICAL_SECTION joinLock;
    1.63 +
    1.64 +/*
    1.65 + * Condition variables are implemented with a combination of a 
    1.66 + * per-thread Windows Event and a per-condition waiting queue.
    1.67 + * The idea is that each thread has its own Event that it waits
    1.68 + * on when it is doing a ConditionWait; it uses the same event for
    1.69 + * all condition variables because it only waits on one at a time.
    1.70 + * Each condition variable has a queue of waiting threads, and a 
    1.71 + * mutex used to serialize access to this queue.
    1.72 + *
    1.73 + * Special thanks to David Nichols and
    1.74 + * Jim Davidson for advice on the Condition Variable implementation.
    1.75 + */
    1.76 +
    1.77 +/*
    1.78 + * The per-thread event and queue pointers.
    1.79 + */
    1.80 +
    1.81 +#ifdef TCL_THREADS
    1.82 +
    1.83 +typedef struct ThreadSpecificData {
    1.84 +    HANDLE condEvent;			/* Per-thread condition event */
    1.85 +    struct ThreadSpecificData *nextPtr;	/* Queue pointers */
    1.86 +    struct ThreadSpecificData *prevPtr;
    1.87 +    int flags;				/* See flags below */
    1.88 +} ThreadSpecificData;
    1.89 +static Tcl_ThreadDataKey dataKey;
    1.90 +
    1.91 +#endif /* TCL_THREADS */
    1.92 +
    1.93 +/*
    1.94 + * Additions by AOL for specialized thread memory allocator.
    1.95 + */
    1.96 +
    1.97 +#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
    1.98 +static int   once;
    1.99 +static DWORD tlsKey;
   1.100 +
   1.101 +typedef struct allocMutex {
   1.102 +    Tcl_Mutex        tlock;
   1.103 +    CRITICAL_SECTION wlock;
   1.104 +} allocMutex;
   1.105 +#endif
   1.106 +
   1.107 +/*
   1.108 + * State bits for the thread.
   1.109 + * WIN_THREAD_UNINIT		Uninitialized.  Must be zero because
   1.110 + *				of the way ThreadSpecificData is created.
   1.111 + * WIN_THREAD_RUNNING		Running, not waiting.
   1.112 + * WIN_THREAD_BLOCKED		Waiting, or trying to wait.
   1.113 + */ 
   1.114 +
   1.115 +#define WIN_THREAD_UNINIT	0x0
   1.116 +#define WIN_THREAD_RUNNING	0x1
   1.117 +#define WIN_THREAD_BLOCKED	0x2
   1.118 +
   1.119 +/*
   1.120 + * The per condition queue pointers and the
   1.121 + * Mutex used to serialize access to the queue.
   1.122 + */
   1.123 +
   1.124 +typedef struct WinCondition {
   1.125 +    CRITICAL_SECTION condLock;	/* Lock to serialize queuing on the condition */
   1.126 +    struct ThreadSpecificData *firstPtr;	/* Queue pointers */
   1.127 +    struct ThreadSpecificData *lastPtr;
   1.128 +} WinCondition;
   1.129 +
   1.130 +
   1.131 +/*
   1.132 + *----------------------------------------------------------------------
   1.133 + *
   1.134 + * TclpThreadCreate --
   1.135 + *
   1.136 + *	This procedure creates a new thread.
   1.137 + *
   1.138 + * Results:
   1.139 + *	TCL_OK if the thread could be created.  The thread ID is
   1.140 + *	returned in a parameter.
   1.141 + *
   1.142 + * Side effects:
   1.143 + *	A new thread is created.
   1.144 + *
   1.145 + *----------------------------------------------------------------------
   1.146 + */
   1.147 +
   1.148 +int
   1.149 +TclpThreadCreate(idPtr, proc, clientData, stackSize, flags)
   1.150 +    Tcl_ThreadId *idPtr;		/* Return, the ID of the thread */
   1.151 +    Tcl_ThreadCreateProc proc;		/* Main() function of the thread */
   1.152 +    ClientData clientData;		/* The one argument to Main() */
   1.153 +    int stackSize;			/* Size of stack for the new thread */
   1.154 +    int flags;				/* Flags controlling behaviour of
   1.155 +					 * the new thread */
   1.156 +{
   1.157 +    HANDLE tHandle;
   1.158 +
   1.159 +    EnterCriticalSection(&joinLock);
   1.160 +
   1.161 +#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
   1.162 +    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize, proc,
   1.163 +	clientData, 0, (unsigned *)idPtr);
   1.164 +#else
   1.165 +    tHandle = CreateThread(NULL, (DWORD) stackSize,
   1.166 +	    (LPTHREAD_START_ROUTINE) proc, (LPVOID) clientData,
   1.167 +	    (DWORD) 0, (LPDWORD)idPtr);
   1.168 +#endif
   1.169 +
   1.170 +    if (tHandle == NULL) {
   1.171 +        LeaveCriticalSection(&joinLock);
   1.172 +	return TCL_ERROR;
   1.173 +    } else {
   1.174 +        if (flags & TCL_THREAD_JOINABLE) {
   1.175 +	    TclRememberJoinableThread (*idPtr);
   1.176 +	}
   1.177 +
   1.178 +	/*
   1.179 +	 * The only purpose of this is to decrement the reference count so the
   1.180 +	 * OS resources will be reaquired when the thread closes.
   1.181 +	 */
   1.182 +
   1.183 +	CloseHandle(tHandle);
   1.184 +	LeaveCriticalSection(&joinLock);
   1.185 +	return TCL_OK;
   1.186 +    }
   1.187 +}
   1.188 +
   1.189 +/*
   1.190 + *----------------------------------------------------------------------
   1.191 + *
   1.192 + * Tcl_JoinThread --
   1.193 + *
   1.194 + *	This procedure waits upon the exit of the specified thread.
   1.195 + *
   1.196 + * Results:
   1.197 + *	TCL_OK if the wait was successful, TCL_ERROR else.
   1.198 + *
   1.199 + * Side effects:
   1.200 + *	The result area is set to the exit code of the thread we
   1.201 + *	waited upon.
   1.202 + *
   1.203 + *----------------------------------------------------------------------
   1.204 + */
   1.205 +
   1.206 +int
   1.207 +Tcl_JoinThread(threadId, result)
   1.208 +    Tcl_ThreadId threadId;  /* Id of the thread to wait upon */
   1.209 +    int*     result;	    /* Reference to the storage the result
   1.210 +			     * of the thread we wait upon will be
   1.211 +			     * written into. */
   1.212 +{
   1.213 +    return TclJoinThread (threadId, result);
   1.214 +}
   1.215 +
   1.216 +/*
   1.217 + *----------------------------------------------------------------------
   1.218 + *
   1.219 + * TclpThreadExit --
   1.220 + *
   1.221 + *	This procedure terminates the current thread.
   1.222 + *
   1.223 + * Results:
   1.224 + *	None.
   1.225 + *
   1.226 + * Side effects:
   1.227 + *	This procedure terminates the current thread.
   1.228 + *
   1.229 + *----------------------------------------------------------------------
   1.230 + */
   1.231 +
   1.232 +void
   1.233 +TclpThreadExit(status)
   1.234 +    int status;
   1.235 +{
   1.236 +    EnterCriticalSection(&joinLock);
   1.237 +    TclSignalExitThread (Tcl_GetCurrentThread (), status);
   1.238 +    LeaveCriticalSection(&joinLock);
   1.239 +
   1.240 +#if defined(_MSC_VER) || defined(__MSVCRT__) || defined(__BORLANDC__)
   1.241 +    _endthreadex((unsigned) status);
   1.242 +#else
   1.243 +    ExitThread((DWORD) status);
   1.244 +#endif
   1.245 +}
   1.246 +
   1.247 +/*
   1.248 + *----------------------------------------------------------------------
   1.249 + *
   1.250 + * Tcl_GetCurrentThread --
   1.251 + *
   1.252 + *	This procedure returns the ID of the currently running thread.
   1.253 + *
   1.254 + * Results:
   1.255 + *	A thread ID.
   1.256 + *
   1.257 + * Side effects:
   1.258 + *	None.
   1.259 + *
   1.260 + *----------------------------------------------------------------------
   1.261 + */
   1.262 +
   1.263 +Tcl_ThreadId
   1.264 +Tcl_GetCurrentThread()
   1.265 +{
   1.266 +    return (Tcl_ThreadId)GetCurrentThreadId();
   1.267 +}
   1.268 +
   1.269 +/*
   1.270 + *----------------------------------------------------------------------
   1.271 + *
   1.272 + * TclpInitLock
   1.273 + *
   1.274 + *	This procedure is used to grab a lock that serializes initialization
   1.275 + *	and finalization of Tcl.  On some platforms this may also initialize
   1.276 + *	the mutex used to serialize creation of more mutexes and thread
   1.277 + *	local storage keys.
   1.278 + *
   1.279 + * Results:
   1.280 + *	None.
   1.281 + *
   1.282 + * Side effects:
   1.283 + *	Acquire the initialization mutex.
   1.284 + *
   1.285 + *----------------------------------------------------------------------
   1.286 + */
   1.287 +
   1.288 +void
   1.289 +TclpInitLock()
   1.290 +{
   1.291 +    if (!init) {
   1.292 +	/*
   1.293 +	 * There is a fundamental race here that is solved by creating
   1.294 +	 * the first Tcl interpreter in a single threaded environment.
   1.295 +	 * Once the interpreter has been created, it is safe to create
   1.296 +	 * more threads that create interpreters in parallel.
   1.297 +	 */
   1.298 +	init = 1;
   1.299 +	InitializeCriticalSection(&joinLock);
   1.300 +	InitializeCriticalSection(&initLock);
   1.301 +	InitializeCriticalSection(&masterLock);
   1.302 +    }
   1.303 +    EnterCriticalSection(&initLock);
   1.304 +}
   1.305 +
   1.306 +/*
   1.307 + *----------------------------------------------------------------------
   1.308 + *
   1.309 + * TclpInitUnlock
   1.310 + *
   1.311 + *	This procedure is used to release a lock that serializes initialization
   1.312 + *	and finalization of Tcl.
   1.313 + *
   1.314 + * Results:
   1.315 + *	None.
   1.316 + *
   1.317 + * Side effects:
   1.318 + *	Release the initialization mutex.
   1.319 + *
   1.320 + *----------------------------------------------------------------------
   1.321 + */
   1.322 +
   1.323 +void
   1.324 +TclpInitUnlock()
   1.325 +{
   1.326 +    LeaveCriticalSection(&initLock);
   1.327 +}
   1.328 +
   1.329 +/*
   1.330 + *----------------------------------------------------------------------
   1.331 + *
   1.332 + * TclpMasterLock
   1.333 + *
   1.334 + *	This procedure is used to grab a lock that serializes creation
   1.335 + *	of mutexes, condition variables, and thread local storage keys.
   1.336 + *
   1.337 + *	This lock must be different than the initLock because the
   1.338 + *	initLock is held during creation of syncronization objects.
   1.339 + *
   1.340 + * Results:
   1.341 + *	None.
   1.342 + *
   1.343 + * Side effects:
   1.344 + *	Acquire the master mutex.
   1.345 + *
   1.346 + *----------------------------------------------------------------------
   1.347 + */
   1.348 +
   1.349 +void
   1.350 +TclpMasterLock()
   1.351 +{
   1.352 +    if (!init) {
   1.353 +	/*
   1.354 +	 * There is a fundamental race here that is solved by creating
   1.355 +	 * the first Tcl interpreter in a single threaded environment.
   1.356 +	 * Once the interpreter has been created, it is safe to create
   1.357 +	 * more threads that create interpreters in parallel.
   1.358 +	 */
   1.359 +	init = 1;
   1.360 +	InitializeCriticalSection(&joinLock);
   1.361 +	InitializeCriticalSection(&initLock);
   1.362 +	InitializeCriticalSection(&masterLock);
   1.363 +    }
   1.364 +    EnterCriticalSection(&masterLock);
   1.365 +}
   1.366 +
   1.367 +/*
   1.368 + *----------------------------------------------------------------------
   1.369 + *
   1.370 + * TclpMasterUnlock
   1.371 + *
   1.372 + *	This procedure is used to release a lock that serializes creation
   1.373 + *	and deletion of synchronization objects.
   1.374 + *
   1.375 + * Results:
   1.376 + *	None.
   1.377 + *
   1.378 + * Side effects:
   1.379 + *	Release the master mutex.
   1.380 + *
   1.381 + *----------------------------------------------------------------------
   1.382 + */
   1.383 +
   1.384 +void
   1.385 +TclpMasterUnlock()
   1.386 +{
   1.387 +    LeaveCriticalSection(&masterLock);
   1.388 +}
   1.389 +
   1.390 +/*
   1.391 + *----------------------------------------------------------------------
   1.392 + *
   1.393 + * Tcl_GetAllocMutex
   1.394 + *
   1.395 + *	This procedure returns a pointer to a statically initialized
   1.396 + *	mutex for use by the memory allocator.  The alloctor must
   1.397 + *	use this lock, because all other locks are allocated...
   1.398 + *
   1.399 + * Results:
   1.400 + *	A pointer to a mutex that is suitable for passing to
   1.401 + *	Tcl_MutexLock and Tcl_MutexUnlock.
   1.402 + *
   1.403 + * Side effects:
   1.404 + *	None.
   1.405 + *
   1.406 + *----------------------------------------------------------------------
   1.407 + */
   1.408 +
   1.409 +Tcl_Mutex *
   1.410 +Tcl_GetAllocMutex()
   1.411 +{
   1.412 +#ifdef TCL_THREADS
   1.413 +    if (!allocOnce) {
   1.414 +	InitializeCriticalSection(&allocLock);
   1.415 +	allocOnce = 1;
   1.416 +    }
   1.417 +    return &allocLockPtr;
   1.418 +#else
   1.419 +    return NULL;
   1.420 +#endif
   1.421 +}
   1.422 +
   1.423 +/*
   1.424 + *----------------------------------------------------------------------
   1.425 + *
   1.426 + * TclpFinalizeLock
   1.427 + *
   1.428 + *	This procedure is used to destroy all private resources used in
   1.429 + *	this file.
   1.430 + *
   1.431 + * Results:
   1.432 + *	None.
   1.433 + *
   1.434 + * Side effects:
   1.435 + *	Destroys everything private.  TclpInitLock must be held
   1.436 + *	entering this function.
   1.437 + *
   1.438 + *----------------------------------------------------------------------
   1.439 + */
   1.440 +
   1.441 +void
   1.442 +TclFinalizeLock ()
   1.443 +{
   1.444 +    MASTER_LOCK;
   1.445 +    DeleteCriticalSection(&joinLock);
   1.446 +    /* Destroy the critical section that we are holding! */
   1.447 +    DeleteCriticalSection(&masterLock);
   1.448 +    init = 0;
   1.449 +#ifdef TCL_THREADS
   1.450 +    DeleteCriticalSection(&allocLock);
   1.451 +    allocOnce = 0;
   1.452 +#endif
   1.453 +    /* Destroy the critical section that we are holding! */
   1.454 +    DeleteCriticalSection(&initLock);
   1.455 +}
   1.456 +
   1.457 +#ifdef TCL_THREADS
   1.458 +
   1.459 +/* locally used prototype */
   1.460 +static void FinalizeConditionEvent(ClientData data);
   1.461 +
   1.462 +
   1.463 +/*
   1.464 + *----------------------------------------------------------------------
   1.465 + *
   1.466 + * Tcl_MutexLock --
   1.467 + *
   1.468 + *	This procedure is invoked to lock a mutex.  This is a self 
   1.469 + *	initializing mutex that is automatically finalized during
   1.470 + *	Tcl_Finalize.
   1.471 + *
   1.472 + * Results:
   1.473 + *	None.
   1.474 + *
   1.475 + * Side effects:
   1.476 + *	May block the current thread.  The mutex is aquired when
   1.477 + *	this returns.
   1.478 + *
   1.479 + *----------------------------------------------------------------------
   1.480 + */
   1.481 +
   1.482 +void
   1.483 +Tcl_MutexLock(mutexPtr)
   1.484 +    Tcl_Mutex *mutexPtr;	/* The lock */
   1.485 +{
   1.486 +    CRITICAL_SECTION *csPtr;
   1.487 +    if (*mutexPtr == NULL) {
   1.488 +	MASTER_LOCK;
   1.489 +
   1.490 +	/* 
   1.491 +	 * Double inside master lock check to avoid a race.
   1.492 +	 */
   1.493 +
   1.494 +	if (*mutexPtr == NULL) {
   1.495 +	    csPtr = (CRITICAL_SECTION *)ckalloc(sizeof(CRITICAL_SECTION));
   1.496 +	    InitializeCriticalSection(csPtr);
   1.497 +	    *mutexPtr = (Tcl_Mutex)csPtr;
   1.498 +	    TclRememberMutex(mutexPtr);
   1.499 +	}
   1.500 +	MASTER_UNLOCK;
   1.501 +    }
   1.502 +    csPtr = *((CRITICAL_SECTION **)mutexPtr);
   1.503 +    EnterCriticalSection(csPtr);
   1.504 +}
   1.505 +
   1.506 +/*
   1.507 + *----------------------------------------------------------------------
   1.508 + *
   1.509 + * Tcl_MutexUnlock --
   1.510 + *
   1.511 + *	This procedure is invoked to unlock a mutex.
   1.512 + *
   1.513 + * Results:
   1.514 + *	None.
   1.515 + *
   1.516 + * Side effects:
   1.517 + *	The mutex is released when this returns.
   1.518 + *
   1.519 + *----------------------------------------------------------------------
   1.520 + */
   1.521 +
   1.522 +void
   1.523 +Tcl_MutexUnlock(mutexPtr)
   1.524 +    Tcl_Mutex *mutexPtr;	/* The lock */
   1.525 +{
   1.526 +    CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);
   1.527 +    LeaveCriticalSection(csPtr);
   1.528 +}
   1.529 +
   1.530 +/*
   1.531 + *----------------------------------------------------------------------
   1.532 + *
   1.533 + * TclpFinalizeMutex --
   1.534 + *
   1.535 + *	This procedure is invoked to clean up one mutex.  This is only
   1.536 + *	safe to call at the end of time.
   1.537 + *
   1.538 + * Results:
   1.539 + *	None.
   1.540 + *
   1.541 + * Side effects:
   1.542 + *	The mutex list is deallocated.
   1.543 + *
   1.544 + *----------------------------------------------------------------------
   1.545 + */
   1.546 +
   1.547 +void
   1.548 +TclpFinalizeMutex(mutexPtr)
   1.549 +    Tcl_Mutex *mutexPtr;
   1.550 +{
   1.551 +    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;
   1.552 +    if (csPtr != NULL) {
   1.553 +	DeleteCriticalSection(csPtr);
   1.554 +	ckfree((char *)csPtr);
   1.555 +	*mutexPtr = NULL;
   1.556 +    }
   1.557 +}
   1.558 +
   1.559 +/*
   1.560 + *----------------------------------------------------------------------
   1.561 + *
   1.562 + * TclpThreadDataKeyInit --
   1.563 + *
   1.564 + *	This procedure initializes a thread specific data block key.
   1.565 + *	Each thread has table of pointers to thread specific data.
   1.566 + *	all threads agree on which table entry is used by each module.
   1.567 + *	this is remembered in a "data key", that is just an index into
   1.568 + *	this table.  To allow self initialization, the interface
   1.569 + *	passes a pointer to this key and the first thread to use
   1.570 + *	the key fills in the pointer to the key.  The key should be
   1.571 + *	a process-wide static.
   1.572 + *
   1.573 + * Results:
   1.574 + *	None.
   1.575 + *
   1.576 + * Side effects:
   1.577 + *	Will allocate memory the first time this process calls for
   1.578 + *	this key.  In this case it modifies its argument
   1.579 + *	to hold the pointer to information about the key.
   1.580 + *
   1.581 + *----------------------------------------------------------------------
   1.582 + */
   1.583 +
   1.584 +void
   1.585 +TclpThreadDataKeyInit(keyPtr)
   1.586 +    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
   1.587 +				 * really (DWORD **) */
   1.588 +{
   1.589 +    DWORD *indexPtr;
   1.590 +    DWORD newKey;
   1.591 +
   1.592 +    MASTER_LOCK;
   1.593 +    if (*keyPtr == NULL) {
   1.594 +	indexPtr = (DWORD *)ckalloc(sizeof(DWORD));
   1.595 +	newKey = TlsAlloc();
   1.596 +        if (newKey != TLS_OUT_OF_INDEXES) {
   1.597 +            *indexPtr = newKey;
   1.598 +        } else {
   1.599 +            panic("TlsAlloc failed from TclpThreadDataKeyInit!"); /* this should be a fatal error */
   1.600 +        }
   1.601 +	*keyPtr = (Tcl_ThreadDataKey)indexPtr;
   1.602 +	TclRememberDataKey(keyPtr);
   1.603 +    }
   1.604 +    MASTER_UNLOCK;
   1.605 +}
   1.606 +
   1.607 +/*
   1.608 + *----------------------------------------------------------------------
   1.609 + *
   1.610 + * TclpThreadDataKeyGet --
   1.611 + *
   1.612 + *	This procedure returns a pointer to a block of thread local storage.
   1.613 + *
   1.614 + * Results:
   1.615 + *	A thread-specific pointer to the data structure, or NULL
   1.616 + *	if the memory has not been assigned to this key for this thread.
   1.617 + *
   1.618 + * Side effects:
   1.619 + *	None.
   1.620 + *
   1.621 + *----------------------------------------------------------------------
   1.622 + */
   1.623 +
   1.624 +VOID *
   1.625 +TclpThreadDataKeyGet(keyPtr)
   1.626 +    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
   1.627 +				 * really (DWORD **) */
   1.628 +{
   1.629 +    DWORD *indexPtr = *(DWORD **)keyPtr;
   1.630 +    LPVOID result;
   1.631 +    if (indexPtr == NULL) {
   1.632 +	return NULL;
   1.633 +    } else {
   1.634 +        result = TlsGetValue(*indexPtr);
   1.635 +        if ((result == NULL) && (GetLastError() != NO_ERROR)) {
   1.636 +            panic("TlsGetValue failed from TclpThreadDataKeyGet!");
   1.637 +        }
   1.638 +	return result;
   1.639 +    }
   1.640 +}
   1.641 +
   1.642 +/*
   1.643 + *----------------------------------------------------------------------
   1.644 + *
   1.645 + * TclpThreadDataKeySet --
   1.646 + *
   1.647 + *	This procedure sets the pointer to a block of thread local storage.
   1.648 + *
   1.649 + * Results:
   1.650 + *	None.
   1.651 + *
   1.652 + * Side effects:
   1.653 + *	Sets up the thread so future calls to TclpThreadDataKeyGet with
   1.654 + *	this key will return the data pointer.
   1.655 + *
   1.656 + *----------------------------------------------------------------------
   1.657 + */
   1.658 +
   1.659 +void
   1.660 +TclpThreadDataKeySet(keyPtr, data)
   1.661 +    Tcl_ThreadDataKey *keyPtr;	/* Identifier for the data chunk,
   1.662 +				 * really (pthread_key_t **) */
   1.663 +    VOID *data;			/* Thread local storage */
   1.664 +{
   1.665 +    DWORD *indexPtr = *(DWORD **)keyPtr;
   1.666 +    BOOL success;
   1.667 +    success = TlsSetValue(*indexPtr, (void *)data);
   1.668 +    if (!success) {
   1.669 +        panic("TlsSetValue failed from TclpThreadDataKeySet!");
   1.670 +    }
   1.671 +}
   1.672 +
   1.673 +/*
   1.674 + *----------------------------------------------------------------------
   1.675 + *
   1.676 + * TclpFinalizeThreadData --
   1.677 + *
   1.678 + *	This procedure cleans up the thread-local storage.  This is
   1.679 + *	called once for each thread.
   1.680 + *
   1.681 + * Results:
   1.682 + *	None.
   1.683 + *
   1.684 + * Side effects:
   1.685 + *	Frees up the memory.
   1.686 + *
   1.687 + *----------------------------------------------------------------------
   1.688 + */
   1.689 +
   1.690 +void
   1.691 +TclpFinalizeThreadData(keyPtr)
   1.692 +    Tcl_ThreadDataKey *keyPtr;
   1.693 +{
   1.694 +    VOID *result;
   1.695 +    DWORD *indexPtr;
   1.696 +    BOOL success;
   1.697 +
   1.698 +    if (*keyPtr != NULL) {
   1.699 +	indexPtr = *(DWORD **)keyPtr;
   1.700 +	result = (VOID *)TlsGetValue(*indexPtr);
   1.701 +	if (result != NULL) {
   1.702 +#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
   1.703 +	    if (indexPtr == &tlsKey) {
   1.704 +		TclpFreeAllocCache(result);
   1.705 +		return;
   1.706 +	    }
   1.707 +#endif
   1.708 +	    ckfree((char *)result);
   1.709 +	    success = TlsSetValue(*indexPtr, (void *)NULL);
   1.710 +            if (!success) {
   1.711 +                panic("TlsSetValue failed from TclpFinalizeThreadData!");
   1.712 +            }
   1.713 +	} else {
   1.714 +            if (GetLastError() != NO_ERROR) {
   1.715 +                panic("TlsGetValue failed from TclpFinalizeThreadData!");
   1.716 +            }
   1.717 +	}
   1.718 +    }
   1.719 +}
   1.720 +
   1.721 +/*
   1.722 + *----------------------------------------------------------------------
   1.723 + *
   1.724 + * TclpFinalizeThreadDataKey --
   1.725 + *
   1.726 + *	This procedure is invoked to clean up one key.  This is a
   1.727 + *	process-wide storage identifier.  The thread finalization code
   1.728 + *	cleans up the thread local storage itself.
   1.729 + *
   1.730 + *	This assumes the master lock is held.
   1.731 + *
   1.732 + * Results:
   1.733 + *	None.
   1.734 + *
   1.735 + * Side effects:
   1.736 + *	The key is deallocated.
   1.737 + *
   1.738 + *----------------------------------------------------------------------
   1.739 + */
   1.740 +
   1.741 +void
   1.742 +TclpFinalizeThreadDataKey(keyPtr)
   1.743 +    Tcl_ThreadDataKey *keyPtr;
   1.744 +{
   1.745 +    DWORD *indexPtr;
   1.746 +    BOOL success;
   1.747 +    if (*keyPtr != NULL) {
   1.748 +	indexPtr = *(DWORD **)keyPtr;
   1.749 +	success = TlsFree(*indexPtr);
   1.750 +        if (!success) {
   1.751 +            panic("TlsFree failed from TclpFinalizeThreadDataKey!");
   1.752 +        }
   1.753 +	ckfree((char *)indexPtr);
   1.754 +	*keyPtr = NULL;
   1.755 +    }
   1.756 +}
   1.757 +
   1.758 +/*
   1.759 + *----------------------------------------------------------------------
   1.760 + *
   1.761 + * Tcl_ConditionWait --
   1.762 + *
   1.763 + *	This procedure is invoked to wait on a condition variable.
   1.764 + *	The mutex is atomically released as part of the wait, and
   1.765 + *	automatically grabbed when the condition is signaled.
   1.766 + *
   1.767 + *	The mutex must be held when this procedure is called.
   1.768 + *
   1.769 + * Results:
   1.770 + *	None.
   1.771 + *
   1.772 + * Side effects:
   1.773 + *	May block the current thread.  The mutex is aquired when
   1.774 + *	this returns.  Will allocate memory for a HANDLE
   1.775 + *	and initialize this the first time this Tcl_Condition is used.
   1.776 + *
   1.777 + *----------------------------------------------------------------------
   1.778 + */
   1.779 +
   1.780 +void
   1.781 +Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
   1.782 +    Tcl_Condition *condPtr;	/* Really (WinCondition **) */
   1.783 +    Tcl_Mutex *mutexPtr;	/* Really (CRITICAL_SECTION **) */
   1.784 +    Tcl_Time *timePtr;		/* Timeout on waiting period */
   1.785 +{
   1.786 +    WinCondition *winCondPtr;	/* Per-condition queue head */
   1.787 +    CRITICAL_SECTION *csPtr;	/* Caller's Mutex, after casting */
   1.788 +    DWORD wtime;		/* Windows time value */
   1.789 +    int timeout;		/* True if we got a timeout */
   1.790 +    int doExit = 0;		/* True if we need to do exit setup */
   1.791 +    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
   1.792 +
   1.793 +    /*
   1.794 +     * Self initialize the two parts of the condition.
   1.795 +     * The per-condition and per-thread parts need to be
   1.796 +     * handled independently.
   1.797 +     */
   1.798 +
   1.799 +    if (tsdPtr->flags == WIN_THREAD_UNINIT) {
   1.800 +	MASTER_LOCK;
   1.801 +
   1.802 +	/* 
   1.803 +	 * Create the per-thread event and queue pointers.
   1.804 +	 */
   1.805 +
   1.806 +	if (tsdPtr->flags == WIN_THREAD_UNINIT) {
   1.807 +	    tsdPtr->condEvent = CreateEvent(NULL, TRUE /* manual reset */,
   1.808 +			FALSE /* non signaled */, NULL);
   1.809 +	    tsdPtr->nextPtr = NULL;
   1.810 +	    tsdPtr->prevPtr = NULL;
   1.811 +	    tsdPtr->flags = WIN_THREAD_RUNNING;
   1.812 +	    doExit = 1;
   1.813 +	}
   1.814 +	MASTER_UNLOCK;
   1.815 +
   1.816 +	if (doExit) {
   1.817 +	    /*
   1.818 +	     * Create a per-thread exit handler to clean up the condEvent.
   1.819 +	     * We must be careful to do this outside the Master Lock
   1.820 +	     * because Tcl_CreateThreadExitHandler uses its own
   1.821 +	     * ThreadSpecificData, and initializing that may drop
   1.822 +	     * back into the Master Lock.
   1.823 +	     */
   1.824 +	    
   1.825 +	    Tcl_CreateThreadExitHandler(FinalizeConditionEvent,
   1.826 +		    (ClientData) tsdPtr);
   1.827 +	}
   1.828 +    }
   1.829 +
   1.830 +    if (*condPtr == NULL) {
   1.831 +	MASTER_LOCK;
   1.832 +
   1.833 +	/*
   1.834 +	 * Initialize the per-condition queue pointers and Mutex.
   1.835 +	 */
   1.836 +
   1.837 +	if (*condPtr == NULL) {
   1.838 +	    winCondPtr = (WinCondition *)ckalloc(sizeof(WinCondition));
   1.839 +	    InitializeCriticalSection(&winCondPtr->condLock);
   1.840 +	    winCondPtr->firstPtr = NULL;
   1.841 +	    winCondPtr->lastPtr = NULL;
   1.842 +	    *condPtr = (Tcl_Condition)winCondPtr;
   1.843 +	    TclRememberCondition(condPtr);
   1.844 +	}
   1.845 +	MASTER_UNLOCK;
   1.846 +    }
   1.847 +    csPtr = *((CRITICAL_SECTION **)mutexPtr);
   1.848 +    winCondPtr = *((WinCondition **)condPtr);
   1.849 +    if (timePtr == NULL) {
   1.850 +	wtime = INFINITE;
   1.851 +    } else {
   1.852 +	wtime = timePtr->sec * 1000 + timePtr->usec / 1000;
   1.853 +    }
   1.854 +
   1.855 +    /*
   1.856 +     * Queue the thread on the condition, using
   1.857 +     * the per-condition lock for serialization.
   1.858 +     */
   1.859 +
   1.860 +    tsdPtr->flags = WIN_THREAD_BLOCKED;
   1.861 +    tsdPtr->nextPtr = NULL;
   1.862 +    EnterCriticalSection(&winCondPtr->condLock);
   1.863 +    tsdPtr->prevPtr = winCondPtr->lastPtr;		/* A: */
   1.864 +    winCondPtr->lastPtr = tsdPtr;
   1.865 +    if (tsdPtr->prevPtr != NULL) {
   1.866 +        tsdPtr->prevPtr->nextPtr = tsdPtr;
   1.867 +    }
   1.868 +    if (winCondPtr->firstPtr == NULL) {
   1.869 +        winCondPtr->firstPtr = tsdPtr;
   1.870 +    }
   1.871 +
   1.872 +    /*
   1.873 +     * Unlock the caller's mutex and wait for the condition, or a timeout.
   1.874 +     * There is a minor issue here in that we don't count down the
   1.875 +     * timeout if we get notified, but another thread grabs the condition
   1.876 +     * before we do.  In that race condition we'll wait again for the
   1.877 +     * full timeout.  Timed waits are dubious anyway.  Either you have
   1.878 +     * the locking protocol wrong and are masking a deadlock,
   1.879 +     * or you are using conditions to pause your thread.
   1.880 +     */
   1.881 +    
   1.882 +    LeaveCriticalSection(csPtr);
   1.883 +    timeout = 0;
   1.884 +    while (!timeout && (tsdPtr->flags & WIN_THREAD_BLOCKED)) {
   1.885 +	ResetEvent(tsdPtr->condEvent);
   1.886 +	LeaveCriticalSection(&winCondPtr->condLock);
   1.887 +	if (WaitForSingleObject(tsdPtr->condEvent, wtime) == WAIT_TIMEOUT) {
   1.888 +	    timeout = 1;
   1.889 +	}
   1.890 +	EnterCriticalSection(&winCondPtr->condLock);
   1.891 +    }
   1.892 +
   1.893 +    /*
   1.894 +     * Be careful on timeouts because the signal might arrive right around
   1.895 +     * the time limit and someone else could have taken us off the queue.
   1.896 +     */
   1.897 +    
   1.898 +    if (timeout) {
   1.899 +	if (tsdPtr->flags & WIN_THREAD_RUNNING) {
   1.900 +	    timeout = 0;
   1.901 +	} else {
   1.902 +	    /*
   1.903 +	     * When dequeuing, we can leave the tsdPtr->nextPtr
   1.904 +	     * and tsdPtr->prevPtr with dangling pointers because
   1.905 +	     * they are reinitialilzed w/out reading them when the
   1.906 +	     * thread is enqueued later.
   1.907 +	     */
   1.908 +
   1.909 +            if (winCondPtr->firstPtr == tsdPtr) {
   1.910 +                winCondPtr->firstPtr = tsdPtr->nextPtr;
   1.911 +            } else {
   1.912 +                tsdPtr->prevPtr->nextPtr = tsdPtr->nextPtr;
   1.913 +            }
   1.914 +            if (winCondPtr->lastPtr == tsdPtr) {
   1.915 +                winCondPtr->lastPtr = tsdPtr->prevPtr;
   1.916 +            } else {
   1.917 +                tsdPtr->nextPtr->prevPtr = tsdPtr->prevPtr;
   1.918 +            }
   1.919 +            tsdPtr->flags = WIN_THREAD_RUNNING;
   1.920 +	}
   1.921 +    }
   1.922 +
   1.923 +    LeaveCriticalSection(&winCondPtr->condLock);
   1.924 +    EnterCriticalSection(csPtr);
   1.925 +}
   1.926 +
   1.927 +/*
   1.928 + *----------------------------------------------------------------------
   1.929 + *
   1.930 + * Tcl_ConditionNotify --
   1.931 + *
   1.932 + *	This procedure is invoked to signal a condition variable.
   1.933 + *
   1.934 + *	The mutex must be held during this call to avoid races,
   1.935 + *	but this interface does not enforce that.
   1.936 + *
   1.937 + * Results:
   1.938 + *	None.
   1.939 + *
   1.940 + * Side effects:
   1.941 + *	May unblock another thread.
   1.942 + *
   1.943 + *----------------------------------------------------------------------
   1.944 + */
   1.945 +
   1.946 +void
   1.947 +Tcl_ConditionNotify(condPtr)
   1.948 +    Tcl_Condition *condPtr;
   1.949 +{
   1.950 +    WinCondition *winCondPtr;
   1.951 +    ThreadSpecificData *tsdPtr;
   1.952 +
   1.953 +    if (condPtr != NULL) {
   1.954 +	winCondPtr = *((WinCondition **)condPtr);
   1.955 +
   1.956 +	if (winCondPtr == NULL) {
   1.957 +	    return;
   1.958 +	}
   1.959 +
   1.960 +	/*
   1.961 +	 * Loop through all the threads waiting on the condition
   1.962 +	 * and notify them (i.e., broadcast semantics).  The queue
   1.963 +	 * manipulation is guarded by the per-condition coordinating mutex.
   1.964 +	 */
   1.965 +
   1.966 +	EnterCriticalSection(&winCondPtr->condLock);
   1.967 +	while (winCondPtr->firstPtr != NULL) {
   1.968 +	    tsdPtr = winCondPtr->firstPtr;
   1.969 +	    winCondPtr->firstPtr = tsdPtr->nextPtr;
   1.970 +	    if (winCondPtr->lastPtr == tsdPtr) {
   1.971 +		winCondPtr->lastPtr = NULL;
   1.972 +	    }
   1.973 +	    tsdPtr->flags = WIN_THREAD_RUNNING;
   1.974 +	    tsdPtr->nextPtr = NULL;
   1.975 +	    tsdPtr->prevPtr = NULL;	/* Not strictly necessary, see A: */
   1.976 +	    SetEvent(tsdPtr->condEvent);
   1.977 +	}
   1.978 +	LeaveCriticalSection(&winCondPtr->condLock);
   1.979 +    } else {
   1.980 +	/*
   1.981 +	 * Noone has used the condition variable, so there are no waiters.
   1.982 +	 */
   1.983 +    }
   1.984 +}
   1.985 +
   1.986 +/*
   1.987 + *----------------------------------------------------------------------
   1.988 + *
   1.989 + * FinalizeConditionEvent --
   1.990 + *
   1.991 + *	This procedure is invoked to clean up the per-thread
   1.992 + *	event used to implement condition waiting.
   1.993 + *	This is only safe to call at the end of time.
   1.994 + *
   1.995 + * Results:
   1.996 + *	None.
   1.997 + *
   1.998 + * Side effects:
   1.999 + *	The per-thread event is closed.
  1.1000 + *
  1.1001 + *----------------------------------------------------------------------
  1.1002 + */
  1.1003 +
  1.1004 +static void
  1.1005 +FinalizeConditionEvent(data)
  1.1006 +    ClientData data;
  1.1007 +{
  1.1008 +    ThreadSpecificData *tsdPtr = (ThreadSpecificData *)data;
  1.1009 +    tsdPtr->flags = WIN_THREAD_UNINIT;
  1.1010 +    CloseHandle(tsdPtr->condEvent);
  1.1011 +}
  1.1012 +
  1.1013 +/*
  1.1014 + *----------------------------------------------------------------------
  1.1015 + *
  1.1016 + * TclpFinalizeCondition --
  1.1017 + *
  1.1018 + *	This procedure is invoked to clean up a condition variable.
  1.1019 + *	This is only safe to call at the end of time.
  1.1020 + *
  1.1021 + *	This assumes the Master Lock is held.
  1.1022 + *
  1.1023 + * Results:
  1.1024 + *	None.
  1.1025 + *
  1.1026 + * Side effects:
  1.1027 + *	The condition variable is deallocated.
  1.1028 + *
  1.1029 + *----------------------------------------------------------------------
  1.1030 + */
  1.1031 +
  1.1032 +void
  1.1033 +TclpFinalizeCondition(condPtr)
  1.1034 +    Tcl_Condition *condPtr;
  1.1035 +{
  1.1036 +    WinCondition *winCondPtr = *(WinCondition **)condPtr;
  1.1037 +
  1.1038 +    /*
  1.1039 +     * Note - this is called long after the thread-local storage is
  1.1040 +     * reclaimed.  The per-thread condition waiting event is
  1.1041 +     * reclaimed earlier in a per-thread exit handler, which is
  1.1042 +     * called before thread local storage is reclaimed.
  1.1043 +     */
  1.1044 +
  1.1045 +    if (winCondPtr != NULL) {
  1.1046 +	DeleteCriticalSection(&winCondPtr->condLock);
  1.1047 +	ckfree((char *)winCondPtr);
  1.1048 +	*condPtr = NULL;
  1.1049 +    }
  1.1050 +}
  1.1051 +
  1.1052 +/*
  1.1053 + * Additions by AOL for specialized thread memory allocator.
  1.1054 + */
  1.1055 +
  1.1056 +#if defined(USE_THREAD_ALLOC) && !defined(TCL_MEM_DEBUG)
  1.1057 +Tcl_Mutex *
  1.1058 +TclpNewAllocMutex(void)
  1.1059 +{
  1.1060 +    struct allocMutex *lockPtr;
  1.1061 +
  1.1062 +    lockPtr = malloc(sizeof(struct allocMutex));
  1.1063 +    if (lockPtr == NULL) {
  1.1064 +	panic("could not allocate lock");
  1.1065 +    }
  1.1066 +    lockPtr->tlock = (Tcl_Mutex) &lockPtr->wlock;
  1.1067 +    InitializeCriticalSection(&lockPtr->wlock);
  1.1068 +    return &lockPtr->tlock;
  1.1069 +}
  1.1070 +
  1.1071 +void
  1.1072 +TclpFreeAllocMutex(mutex)
  1.1073 +    Tcl_Mutex *mutex; /* The alloc mutex to free. */
  1.1074 +{
  1.1075 +    allocMutex* lockPtr = (allocMutex*) mutex;
  1.1076 +    if (!lockPtr) return;
  1.1077 +    DeleteCriticalSection(&lockPtr->wlock);
  1.1078 +    free(lockPtr);
  1.1079 +}
  1.1080 +
  1.1081 +void *
  1.1082 +TclpGetAllocCache(void)
  1.1083 +{
  1.1084 +    VOID *result;
  1.1085 +
  1.1086 +    if (!once) {
  1.1087 +	/*
  1.1088 +	 * We need to make sure that TclpFreeAllocCache is called
  1.1089 +	 * on each thread that calls this, but only on threads that
  1.1090 +	 * call this.
  1.1091 +	 */
  1.1092 +    	tlsKey = TlsAlloc();
  1.1093 +	once = 1;
  1.1094 +	if (tlsKey == TLS_OUT_OF_INDEXES) {
  1.1095 +	    panic("could not allocate thread local storage");
  1.1096 +	}
  1.1097 +    }
  1.1098 +
  1.1099 +    result = TlsGetValue(tlsKey);
  1.1100 +    if ((result == NULL) && (GetLastError() != NO_ERROR)) {
  1.1101 +        panic("TlsGetValue failed from TclpGetAllocCache!");
  1.1102 +    }
  1.1103 +    return result;
  1.1104 +}
  1.1105 +
  1.1106 +void
  1.1107 +TclpSetAllocCache(void *ptr)
  1.1108 +{
  1.1109 +    BOOL success;
  1.1110 +    success = TlsSetValue(tlsKey, ptr);
  1.1111 +    if (!success) {
  1.1112 +        panic("TlsSetValue failed from TclpSetAllocCache!");
  1.1113 +    }
  1.1114 +}
  1.1115 +
  1.1116 +void
  1.1117 +TclpFreeAllocCache(void *ptr)
  1.1118 +{
  1.1119 +    BOOL success;
  1.1120 +
  1.1121 +    if (ptr != NULL) {
  1.1122 +        /*
  1.1123 +         * Called by the pthread lib when a thread exits
  1.1124 +         */
  1.1125 +        TclFreeAllocCache(ptr);
  1.1126 +        success = TlsSetValue(tlsKey, NULL);
  1.1127 +        if (!success) {
  1.1128 +            panic("TlsSetValue failed from TclpFreeAllocCache!");
  1.1129 +        }
  1.1130 +    } else if (once) { 
  1.1131 +        /*
  1.1132 +         * Called by us in TclFinalizeThreadAlloc() during
  1.1133 +         * the library finalization initiated from Tcl_Finalize()
  1.1134 +         */
  1.1135 +        success = TlsFree(tlsKey);
  1.1136 +        if (!success) {
  1.1137 +            Tcl_Panic("TlsFree failed from TclpFreeAllocCache!");
  1.1138 +        }
  1.1139 +        once = 0; /* reset for next time. */
  1.1140 +    }
  1.1141 +}
  1.1142 +
  1.1143 +#endif /* USE_THREAD_ALLOC */
  1.1144 +#endif /* TCL_THREADS */