Changes On Branch windows-thread-join
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Changes In Branch windows-thread-join Excluding Merge-Ins

This is equivalent to a diff from 20891426a8 to 9c9f39bc30

2023-06-11
07:29
Merge trunk [20891426a8]. check-in: 56d7f41983 user: pooryorick tags: trunk-encodingdefaultstrict
2023-05-04
04:48
Better fallback on list reallocation failure check-in: 66350977dd user: apnadkarni tags: trunk, main
2023-05-03
16:12
Merge 9.0. Further Makefile tweaks Leaf check-in: 9c9f39bc30 user: jan.nijtmans tags: windows-thread-join
15:59
Merge 8.7 check-in: 20891426a8 user: jan.nijtmans tags: trunk, main
15:51
Backport "Comments only. Fix blatantly obsolete ones". And a few more improvements from the same fil... check-in: 797753b302 user: jan.nijtmans tags: core-8-branch
15:18
Removed the bug specific test constraint from the tests related to [0306a5563c] because the bug is ... check-in: 1c4a696c6b user: pointsman tags: trunk, main
2023-04-03
07:41
Windows Threads are joinable check-in: af4d891ecb user: mchn1350 tags: windows-thread-join

Changes to doc/Thread.3.
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
103
104
105
106
107
108
109


110
111
112
113
114
115
116







-
-







Using the second value marks the new thread as \fIjoinable\fR. This
means that another thread can wait for the such marked thread to exit
and join it.
.PP
Restrictions: On some UNIX systems the pthread-library does not
contain the functionality to specify the stack size of a thread. The
specified value for the stack size is ignored on these systems.
Windows currently does not support joinable threads. This
flag value is therefore ignored on this platform.
.PP
Tcl provides the \fBTcl_ExitThread\fR and \fBTcl_FinalizeThread\fR functions
for terminating threads and invoking optional per-thread exit
handlers.  See the \fBTcl_Exit\fR page for more information on these
procedures.
.PP
The \fBTcl_JoinThread\fR function is provided to allow threads to wait
154
155
156
157
158
159
160
161

162
163

164
165
166
167
168
169
170
152
153
154
155
156
157
158

159
160

161
162
163
164
165
166
167
168







-
+

-
+







This macro assures correct mutex handling even when the core is compiled
without threads enabled.
.PP
A condition variable is used as a signaling mechanism:
a thread can lock a mutex and then wait on a condition variable
with \fBTcl_ConditionWait\fR.  This atomically releases the mutex lock
and blocks the waiting thread until another thread calls
\fBTcl_ConditionNotify\fR.  The caller of \fBTcl_ConditionNotify\fR should
\fBTcl_ConditionNotify\fR.  The caller of \fBTcl_ConditionNotify\fR may
have the associated mutex held by previously calling \fBTcl_MutexLock\fR,
but this is not enforced.  Notifying the
but this tends to produce more thread context switches.  Notifying the
condition variable unblocks all threads waiting on the condition variable,
but they do not proceed until the mutex is released with \fBTcl_MutexUnlock\fR.
The implementation of \fBTcl_ConditionWait\fR automatically locks
the mutex before returning.
.PP
The caller of \fBTcl_ConditionWait\fR should be prepared for spurious
notifications by calling \fBTcl_ConditionWait\fR within a while loop
Changes to generic/tclInt.h.
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3231
3232
3233
3234
3235
3236
3237

3238
3239
3240
3241
3242
3243
3244







-







			    int forceRelative);
MODULE_SCOPE int	MakeTildeRelativePath(Tcl_Interp *interp, const char *user,
			    const char *subPath, Tcl_DString *dsPtr);
MODULE_SCOPE Tcl_Obj *	TclGetHomeDirObj(Tcl_Interp *interp, const char *user);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePath(Tcl_Interp *interp,
			    Tcl_Obj *pathObj);
MODULE_SCOPE Tcl_Obj *	TclResolveTildePathList(Tcl_Obj *pathsObj);
MODULE_SCOPE int	TclJoinThread(Tcl_ThreadId id, int *result);
MODULE_SCOPE void	TclLimitRemoveAllHandlers(Tcl_Interp *interp);
MODULE_SCOPE Tcl_Obj *	TclLindexList(Tcl_Interp *interp,
			    Tcl_Obj *listPtr, Tcl_Obj *argPtr);
MODULE_SCOPE Tcl_Obj *	TclLindexFlat(Tcl_Interp *interp, Tcl_Obj *listPtr,
			    Tcl_Size indexCount, Tcl_Obj *const indexArray[]);
/* TIP #280 */
MODULE_SCOPE void	TclListLines(Tcl_Obj *listObj, Tcl_Size line, int n,
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3358
3359
3360
3361
3362
3363
3364

3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382

3383
3384
3385
3386
3387
3388
3389







-


















-







			    Tcl_DString *linkPtr);
MODULE_SCOPE void	TclpSetVariables(Tcl_Interp *interp);
MODULE_SCOPE void *	TclThreadStorageKeyGet(Tcl_ThreadDataKey *keyPtr);
MODULE_SCOPE void	TclThreadStorageKeySet(Tcl_ThreadDataKey *keyPtr,
			    void *data);
MODULE_SCOPE TCL_NORETURN void TclpThreadExit(int status);
MODULE_SCOPE void	TclRememberCondition(Tcl_Condition *mutex);
MODULE_SCOPE void	TclRememberJoinableThread(Tcl_ThreadId id);
MODULE_SCOPE void	TclRememberMutex(Tcl_Mutex *mutex);
MODULE_SCOPE void	TclRemoveScriptLimitCallbacks(Tcl_Interp *interp);
MODULE_SCOPE int	TclReToGlob(Tcl_Interp *interp, const char *reStr,
			    Tcl_Size reStrLen, Tcl_DString *dsPtr, int *flagsPtr,
			    int *quantifiersFoundPtr);
MODULE_SCOPE Tcl_Size	TclScanElement(const char *string, Tcl_Size length,
			    char *flagPtr);
MODULE_SCOPE void	TclSetBgErrorHandler(Tcl_Interp *interp,
			    Tcl_Obj *cmdPrefix);
MODULE_SCOPE void	TclSetBignumInternalRep(Tcl_Obj *objPtr,
			    void *bignumValue);
MODULE_SCOPE int	TclSetBooleanFromAny(Tcl_Interp *interp,
			    Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
			    Command *cmdPtr);
MODULE_SCOPE void	TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr);
MODULE_SCOPE void	TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr,
			    Tcl_Obj *newValue, Tcl_Encoding encoding);
MODULE_SCOPE void	TclSignalExitThread(Tcl_ThreadId id, int result);
MODULE_SCOPE void	TclSpellFix(Tcl_Interp *interp,
			    Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx,
			    Tcl_Obj *bad, Tcl_Obj *fix);
MODULE_SCOPE void *	TclStackRealloc(Tcl_Interp *interp, void *ptr,
			    Tcl_Size numBytes);
typedef int (*memCmpFn_t)(const void*, const void*, size_t);
MODULE_SCOPE int	TclStringCmp(Tcl_Obj *value1Ptr, Tcl_Obj *value2Ptr,
Deleted generic/tclThreadJoin.c.
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318






























































































































































































































































































































-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
/*
 * tclThreadJoin.c --
 *
 *	This file implements a platform independent emulation layer for the
 *	handling of joinable threads. The Windows platform uses this code to
 *	provide the functionality of joining threads.  This code is currently
 *	not necessary on Unix.
 *
 * Copyright © 2000 Scriptics Corporation
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#ifdef _WIN32

/*
 * The information about each joinable thread is remembered in a structure as
 * defined below.
 */

typedef struct JoinableThread {
    Tcl_ThreadId  id;		/* The id of the joinable thread. */
    int result;			/* A place for the result after the demise of
				 * the thread. */
    int done;			/* Boolean flag. Initialized to 0 and set to 1
				 * after the exit of the thread. This allows a
				 * thread requesting a join to detect when
				 * waiting is not necessary. */
    int waitedUpon;		/* Boolean flag. Initialized to 0 and set to 1
				 * by the thread waiting for this one via
				 * Tcl_JoinThread.  Used to lock any other
				 * thread trying to wait on this one. */
    Tcl_Mutex threadMutex;	/* The mutex used to serialize access to this
				 * structure. */
    Tcl_Condition cond;		/* This is the condition a thread has to wait
				 * upon to get notified of the end of the
				 * described thread. It is signaled indirectly
				 * by Tcl_ExitThread. */
    struct JoinableThread *nextThreadPtr;
				/* Reference to the next thread in the list of
				 * joinable threads. */
} JoinableThread;

/*
 * The following variable is used to maintain the global list of all joinable
 * threads. Usage by a thread is allowed only if the thread acquired the
 * 'joinMutex'.
 */

TCL_DECLARE_MUTEX(joinMutex)

static JoinableThread *firstThreadPtr;

/*
 *----------------------------------------------------------------------
 *
 * TclJoinThread --
 *
 *	This procedure waits for the exit of the thread with the specified id
 *	and returns its result.
 *
 * Results:
 *	A standard tcl result signaling the overall success/failure of the
 *	operation and an integer result delivered by the thread which was
 *	waited upon.
 *
 * Side effects:
 *	Deallocates the memory allocated by TclRememberJoinableThread.
 *	Removes the data associated to the thread waited upon from the list of
 *	joinable threads.
 *
 *----------------------------------------------------------------------
 */

int
TclJoinThread(
    Tcl_ThreadId id,		/* The id of the thread to wait upon. */
    int *result)		/* Reference to a location for the result of
				 * the thread we are waiting upon. */
{
    JoinableThread *threadPtr;

    /*
     * Steps done here:
     * i.    Acquire the joinMutex and search for the thread.
     * ii.   Error out if it could not be found.
     * iii.  If found, switch from exclusive access to the list to exclusive
     *	     access to the thread structure.
     * iv.   Error out if some other is already waiting.
     * v.    Skip the waiting part of the thread is already done.
     * vi.   Wait for the thread to exit, mark it as waited upon too.
     * vii.  Get the result form the structure,
     * viii. switch to exclusive access of the list,
     * ix.   remove the structure from the list,
     * x.    then switch back to exclusive access to the structure
     * xi.   and delete it.
     */

    Tcl_MutexLock(&joinMutex);

    threadPtr = firstThreadPtr;
    while (threadPtr!=NULL && threadPtr->id!=id) {
	threadPtr = threadPtr->nextThreadPtr;
    }

    if (threadPtr == NULL) {
	/*
	 * Thread not found. Either not joinable, or already waited upon and
	 * exited. Whatever, an error is in order.
	 */

	Tcl_MutexUnlock(&joinMutex);
	return TCL_ERROR;
    }

    /*
     * [1] If we don't lock the structure before giving up exclusive access to
     * the list some other thread just completing its wait on the same thread
     * can delete the structure from under us, leaving us with a dangling
     * pointer.
     */

    Tcl_MutexLock(&threadPtr->threadMutex);
    Tcl_MutexUnlock(&joinMutex);

    /*
     * [2] Now that we have the structure mutex any other thread that just
     * tries to delete structure will wait at location [3] until we are done
     * with the structure. And in that case we are done with it rather quickly
     * as 'waitedUpon' will be set and we will have to error out.
     */

    if (threadPtr->waitedUpon) {
	Tcl_MutexUnlock(&threadPtr->threadMutex);
	return TCL_ERROR;
    }

    /*
     * We are waiting now, let other threads recognize this.
     */

    threadPtr->waitedUpon = 1;

    while (!threadPtr->done) {
	Tcl_ConditionWait(&threadPtr->cond, &threadPtr->threadMutex, NULL);
    }

    /*
     * We have to release the structure before trying to access the list again
     * or we can run into deadlock with a thread at [1] (see above) because of
     * us holding the structure and the other holding the list.  There is no
     * problem with dangling pointers here as 'waitedUpon == 1' is still valid
     * and any other thread will error out and not come to this place. IOW,
     * the fact that we are here also means that no other thread came here
     * before us and is able to delete the structure.
     */

    Tcl_MutexUnlock(&threadPtr->threadMutex);
    Tcl_MutexLock(&joinMutex);

    /*
     * We have to search the list again as its structure may (may, almost
     * certainly) have changed while we were waiting. Especially now is the
     * time to compute the predecessor in the list. Any earlier result can be
     * dangling by now.
     */

    if (firstThreadPtr == threadPtr) {
	firstThreadPtr = threadPtr->nextThreadPtr;
    } else {
	JoinableThread *prevThreadPtr = firstThreadPtr;

	while (prevThreadPtr->nextThreadPtr != threadPtr) {
	    prevThreadPtr = prevThreadPtr->nextThreadPtr;
	}
	prevThreadPtr->nextThreadPtr = threadPtr->nextThreadPtr;
    }

    Tcl_MutexUnlock(&joinMutex);

    /*
     * [3] Now that the structure is not part of the list anymore no other
     * thread can acquire its mutex from now on. But it is possible that
     * another thread is still holding the mutex though, see location [2].  So
     * we have to acquire the mutex one more time to wait for that thread to
     * finish. We can (and have to) release the mutex immediately.
     */

    Tcl_MutexLock(&threadPtr->threadMutex);
    Tcl_MutexUnlock(&threadPtr->threadMutex);

    /*
     * Copy the result to us, finalize the synchronisation objects, then free
     * the structure and return.
     */

    *result = threadPtr->result;

    Tcl_ConditionFinalize(&threadPtr->cond);
    Tcl_MutexFinalize(&threadPtr->threadMutex);
    Tcl_Free(threadPtr);

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclRememberJoinableThread --
 *
 *	This procedure remembers a thread as joinable. Only a call to
 *	TclJoinThread will remove the structure created (and initialized) here.
 *	IOW, not waiting upon a joinable thread will cause memory leaks.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Allocates memory, adds it to the global list of all joinable threads.
 *
 *----------------------------------------------------------------------
 */

void
TclRememberJoinableThread(
    Tcl_ThreadId id)		/* The thread to remember as joinable */
{
    JoinableThread *threadPtr;

    threadPtr = (JoinableThread *)Tcl_Alloc(sizeof(JoinableThread));
    threadPtr->id = id;
    threadPtr->done = 0;
    threadPtr->waitedUpon = 0;
    threadPtr->threadMutex = (Tcl_Mutex) NULL;
    threadPtr->cond = (Tcl_Condition) NULL;

    Tcl_MutexLock(&joinMutex);

    threadPtr->nextThreadPtr = firstThreadPtr;
    firstThreadPtr = threadPtr;

    Tcl_MutexUnlock(&joinMutex);
}

/*
 *----------------------------------------------------------------------
 *
 * TclSignalExitThread --
 *
 *	This procedure signals that the specified thread is done with its
 *	work. If the thread is joinable this signal is propagated to the
 *	thread waiting upon it.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Modifies the associated structure to hold the result.
 *
 *----------------------------------------------------------------------
 */

void
TclSignalExitThread(
    Tcl_ThreadId id,		/* Id of the thread signaling its exit. */
    int result)			/* The result from the thread. */
{
    JoinableThread *threadPtr;

    Tcl_MutexLock(&joinMutex);

    threadPtr = firstThreadPtr;
    while ((threadPtr != NULL) && (threadPtr->id != id)) {
	threadPtr = threadPtr->nextThreadPtr;
    }

    if (threadPtr == NULL) {
	/*
	 * Thread not found. Not joinable. No problem, nothing to do.
	 */

	Tcl_MutexUnlock(&joinMutex);
	return;
    }

    /*
     * Switch over the exclusive access from the list to the structure, then
     * store the result, set the flag and notify the waiting thread, provided
     * that it exists. The order of lock/unlock ensures that a thread entering
     * 'TclJoinThread' will not interfere with us.
     */

    Tcl_MutexLock(&threadPtr->threadMutex);
    Tcl_MutexUnlock(&joinMutex);

    threadPtr->done = 1;
    threadPtr->result = result;

    if (threadPtr->waitedUpon) {
	Tcl_ConditionNotify(&threadPtr->cond);
    }

    Tcl_MutexUnlock(&threadPtr->threadMutex);
}
#else
TCL_MAC_EMPTY_FILE(generic_tclThreadJoin_c)
#endif /* _WIN32 */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */
Changes to macosx/Tcl.xcodeproj/project.pbxproj.
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
82
83
84
85
86
87
88

89
90
91
92
93
94
95







-







		F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2508F272A7004A47F5 /* tclStubInit.c */; };
		F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2608F272A7004A47F5 /* tclStubLib.c */; };
		F96D45C608F272BC004A47F5 /* tclTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2708F272A7004A47F5 /* tclTest.c */; };
		F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2808F272A7004A47F5 /* tclTestObj.c */; };
		F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */; };
		F96D45C908F272BC004A47F5 /* tclThread.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2A08F272A7004A47F5 /* tclThread.c */; };
		F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */; };
		F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */; };
		F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */; };
		F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */; };
		F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F2F08F272A7004A47F5 /* tclTimer.c */; };
		F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */; };
		F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3208F272A7004A47F5 /* tclTrace.c */; };
		F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3408F272A7004A47F5 /* tclUtf.c */; };
		F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */ = {isa = PBXBuildFile; fileRef = F96D3F3508F272A7004A47F5 /* tclUtil.c */; };
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
517
518
519
520
521
522
523

524
525
526
527
528
529
530







-







		F96D3F2508F272A7004A47F5 /* tclStubInit.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubInit.c; sourceTree = "<group>"; };
		F96D3F2608F272A7004A47F5 /* tclStubLib.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclStubLib.c; sourceTree = "<group>"; };
		F96D3F2708F272A7004A47F5 /* tclTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTest.c; sourceTree = "<group>"; };
		F96D3F2808F272A7004A47F5 /* tclTestObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestObj.c; sourceTree = "<group>"; };
		F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTestProcBodyObj.c; sourceTree = "<group>"; };
		F96D3F2A08F272A7004A47F5 /* tclThread.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThread.c; sourceTree = "<group>"; };
		F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadAlloc.c; sourceTree = "<group>"; };
		F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadJoin.c; sourceTree = "<group>"; };
		F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadStorage.c; sourceTree = "<group>"; };
		F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclThreadTest.c; sourceTree = "<group>"; };
		F96D3F2F08F272A7004A47F5 /* tclTimer.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTimer.c; sourceTree = "<group>"; };
		F96D3F3008F272A7004A47F5 /* tclTomMath.h */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.h; path = tclTomMath.h; sourceTree = "<group>"; };
		F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTomMathInterface.c; sourceTree = "<group>"; };
		F96D3F3208F272A7004A47F5 /* tclTrace.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclTrace.c; sourceTree = "<group>"; };
		F96D3F3308F272A7004A47F5 /* tclUniData.c */ = {isa = PBXFileReference; fileEncoding = 4; lastKnownFileType = sourcecode.c.c; path = tclUniData.c; sourceTree = "<group>"; };
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1291
1292
1293
1294
1295
1296
1297

1298
1299
1300
1301
1302
1303
1304







-







				F96D3F2508F272A7004A47F5 /* tclStubInit.c */,
				F96D3F2608F272A7004A47F5 /* tclStubLib.c */,
				F96D3F2708F272A7004A47F5 /* tclTest.c */,
				F96D3F2808F272A7004A47F5 /* tclTestObj.c */,
				F96D3F2908F272A7004A47F5 /* tclTestProcBodyObj.c */,
				F96D3F2A08F272A7004A47F5 /* tclThread.c */,
				F96D3F2B08F272A7004A47F5 /* tclThreadAlloc.c */,
				F96D3F2C08F272A7004A47F5 /* tclThreadJoin.c */,
				F96D3F2D08F272A7004A47F5 /* tclThreadStorage.c */,
				F96D3F2E08F272A7004A47F5 /* tclThreadTest.c */,
				F96D3F2F08F272A7004A47F5 /* tclTimer.c */,
				F9903CAF094FAADA004613E9 /* tclTomMath.decls */,
				F96D3F3008F272A7004A47F5 /* tclTomMath.h */,
				F9903CB0094FAADA004613E9 /* tclTomMathDecls.h */,
				F96D3F3108F272A7004A47F5 /* tclTomMathInterface.c */,
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
1993
1994
1995
1996
1997
1998
1999

2000
2001
2002
2003
2004
2005
2006







-







				F96D45C408F272BC004A47F5 /* tclStubInit.c in Sources */,
				F96D45C508F272BC004A47F5 /* tclStubLib.c in Sources */,
				F96D45C608F272BC004A47F5 /* tclTest.c in Sources */,
				F96D45C708F272BC004A47F5 /* tclTestObj.c in Sources */,
				F96D45C808F272BC004A47F5 /* tclTestProcBodyObj.c in Sources */,
				F96D45C908F272BC004A47F5 /* tclThread.c in Sources */,
				F96D45CA08F272BC004A47F5 /* tclThreadAlloc.c in Sources */,
				F96D45CB08F272BC004A47F5 /* tclThreadJoin.c in Sources */,
				F96D45CC08F272BC004A47F5 /* tclThreadStorage.c in Sources */,
				F96D45CD08F272BC004A47F5 /* tclThreadTest.c in Sources */,
				F96D45CE08F272BC004A47F5 /* tclTimer.c in Sources */,
				F96D45D008F272BC004A47F5 /* tclTomMathInterface.c in Sources */,
				F96D45D108F272BC004A47F5 /* tclTrace.c in Sources */,
				F96D45D308F272BC004A47F5 /* tclUtf.c in Sources */,
				F96D45D408F272BC004A47F5 /* tclUtil.c in Sources */,
Changes to unix/Makefile.in.
310
311
312
313
314
315
316
317

318
319
320
321
322
323
324
310
311
312
313
314
315
316

317
318
319
320
321
322
323
324







-
+







	tclLink.o tclListObj.o \
	tclLiteral.o tclLoad.o tclMain.o tclNamesp.o tclNotify.o \
	tclObj.o tclOptimize.o tclPanic.o tclParse.o tclPathObj.o tclPipe.o \
	tclPkg.o tclPkgConfig.o tclPosixStr.o \
	tclPreserve.o tclProc.o tclProcess.o tclRegexp.o \
	tclResolve.o tclResult.o tclScan.o tclStringObj.o \
	tclStrToD.o tclThread.o \
	tclThreadAlloc.o tclThreadJoin.o tclThreadStorage.o tclStubInit.o \
	tclThreadAlloc.o tclThreadStorage.o tclStubInit.o \
	tclTimer.o tclTrace.o tclUtf.o tclUtil.o tclVar.o tclZlib.o \
	tclTomMathInterface.o tclZipfs.o

OO_OBJS = tclOO.o tclOOBasic.o tclOOCall.o tclOODefineCmds.o tclOOInfo.o \
	tclOOMethod.o tclOOStubInit.o

TOMMATH_OBJS = bn_s_mp_reverse.o bn_s_mp_mul_digs_fast.o \
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
468
469
470
471
472
473
474

475
476
477
478
479
480
481







-







	$(GENERIC_DIR)/tclStringObj.c \
	$(GENERIC_DIR)/tclStrToD.c \
	$(GENERIC_DIR)/tclTest.c \
	$(GENERIC_DIR)/tclTestObj.c \
	$(GENERIC_DIR)/tclTestProcBodyObj.c \
	$(GENERIC_DIR)/tclThread.c \
	$(GENERIC_DIR)/tclThreadAlloc.c \
	$(GENERIC_DIR)/tclThreadJoin.c \
	$(GENERIC_DIR)/tclThreadStorage.c \
	$(GENERIC_DIR)/tclTimer.c \
	$(GENERIC_DIR)/tclTrace.c \
	$(GENERIC_DIR)/tclUtil.c \
	$(GENERIC_DIR)/tclVar.c \
	$(GENERIC_DIR)/tclAssembly.c \
	$(GENERIC_DIR)/tclZlib.c \
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1569
1570
1571
1572
1573
1574
1575



1576
1577
1578
1579
1580
1581
1582







-
-
-








tclThread.o: $(GENERIC_DIR)/tclThread.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThread.c

tclThreadAlloc.o: $(GENERIC_DIR)/tclThreadAlloc.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadAlloc.c

tclThreadJoin.o: $(GENERIC_DIR)/tclThreadJoin.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadJoin.c

tclThreadStorage.o: $(GENERIC_DIR)/tclThreadStorage.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclThreadStorage.c

tclThreadTest.o: $(GENERIC_DIR)/tclThreadTest.c
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclThreadTest.c

tclTomMathInterface.o: $(GENERIC_DIR)/tclTomMathInterface.c $(MATHHDRS)
Changes to win/Makefile.in.
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
350
351
352
353
354
355
356

357
358
359
360
361
362
363







-







	tclResult.$(OBJEXT) \
	tclScan.$(OBJEXT) \
	tclStringObj.$(OBJEXT) \
	tclStrToD.$(OBJEXT) \
	tclStubInit.$(OBJEXT) \
	tclThread.$(OBJEXT) \
	tclThreadAlloc.$(OBJEXT) \
	tclThreadJoin.$(OBJEXT) \
	tclThreadStorage.$(OBJEXT) \
	tclTimer.$(OBJEXT) \
	tclTomMathInterface.$(OBJEXT) \
	tclTrace.$(OBJEXT) \
	tclUtf.$(OBJEXT) \
	tclUtil.$(OBJEXT) \
	tclVar.$(OBJEXT) \
Changes to win/makefile.vc.
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
306
307
308
309
310
311
312

313
314
315
316
317
318
319







-







	$(TMP_DIR)\tclResult.obj \
	$(TMP_DIR)\tclScan.obj \
	$(TMP_DIR)\tclStringObj.obj \
	$(TMP_DIR)\tclStrToD.obj \
	$(TMP_DIR)\tclStubInit.obj \
	$(TMP_DIR)\tclThread.obj \
	$(TMP_DIR)\tclThreadAlloc.obj \
	$(TMP_DIR)\tclThreadJoin.obj \
	$(TMP_DIR)\tclThreadStorage.obj \
	$(TMP_DIR)\tclTimer.obj \
	$(TMP_DIR)\tclTomMathInterface.obj \
	$(TMP_DIR)\tclTrace.obj \
	$(TMP_DIR)\tclUtf.obj \
	$(TMP_DIR)\tclUtil.obj \
	$(TMP_DIR)\tclVar.obj \
Changes to win/tcl.dsp.
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1314
1315
1316
1317
1318
1319
1320




1321
1322
1323
1324
1325
1326
1327







-
-
-
-








SOURCE=..\generic\tclTestProcBodyObj.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclThread.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclThreadJoin.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclThreadTest.c
# End Source File
# Begin Source File

SOURCE=..\generic\tclTimer.c
Changes to win/tclWinThrd.c.
17
18
19
20
21
22
23




24
25
26
27




28
29

30
31
32
33
34
35




36
37




38
39
40
41
42




43
44
45
46
47
48
49




50
51
52
53
54
55
56
57
58
59
60

61
62

63
64
65
66
67
68
69
70
71
72
73
74

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89

90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108

109
110

111
112
113
114
115
116
117
118

119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137








138
139


































140
141
142
143
144
145
146
17
18
19
20
21
22
23
24
25
26
27




28
29
30
31


32

33




34
35
36
37
38

39
40
41
42
43




44
45
46
47
48
49
50




51
52
53
54

55
56
57







58


59












60













61

62



















63


64


65
66




67


68





69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130







+
+
+
+
-
-
-
-
+
+
+
+
-
-
+
-

-
-
-
-
+
+
+
+

-
+
+
+
+

-
-
-
-
+
+
+
+



-
-
-
-
+
+
+
+
-



-
-
-
-
-
-
-
+
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-

-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
+
-
-


-
-
-
-
+
-
-

-
-
-
-
-











+
+
+
+
+
+
+
+


+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







#ifndef _MCW_EM
#   define	_MCW_EM		0x0008001F	/* Error masks */
#   define	_MCW_RC		0x00000300	/* Rounding */
#   define	_MCW_PC		0x00030000	/* Precision */
_CRTIMP unsigned int __cdecl _controlfp (unsigned int unNew, unsigned int unMask);
#endif

static struct tclWinGlobals {
    INIT_ONCE init_once;	/* must be first member,
		because of static initialziation */

/*
 * This is the global lock used to serialize access to other serialization
 * data structures.
 */
    /*
     * This is the global lock used to serialize access to other serialization
     * data structures.
     */

static CRITICAL_SECTION globalLock;
    CRITICAL_SECTION globalLock;
static int initialized = 0;

/*
 * This is the global lock used to serialize initialization and finalization
 * of Tcl as a whole.
 */
    /*
     * This is the global lock used to serialize initialization and finalization
     * of Tcl as a whole.
     */

static CRITICAL_SECTION initLock;
    CRITICAL_SECTION initLock;

    /* holds the TLS key for the Tcl Thread_ID */
    DWORD tls_thread_id;

/*
 * allocLock is used by Tcl's version of malloc for synchronization. For
 * obvious reasons, cannot use any dyamically allocated storage.
 */
    /*
     * allocLock is used by Tcl's version of malloc for synchronization. For
     * obvious reasons, cannot use any dyamically allocated storage.
     */

#if TCL_THREADS

static struct Tcl_Mutex_ {
    CRITICAL_SECTION crit;
} allocLock;
static Tcl_Mutex allocLockPtr = &allocLock;
    struct Tcl_Mutex_ {
	CRITICAL_SECTION crit;
    } allocLock;
    Tcl_Mutex allocLockPtr;
static int allocOnce = 0;

#endif /* TCL_THREADS */

/*
 * The joinLock serializes Create- and ExitThread. This is necessary to
 * prevent a race where a new joinable thread exits before the creating thread
 * had the time to create the necessary data structures in the emulation
 * layer.
 */

} TclWinGlobals = {
static CRITICAL_SECTION joinLock;

    INIT_ONCE_STATIC_INIT
/*
 * Condition variables are implemented with a combination of a per-thread
 * Windows Event and a per-condition waiting queue. The idea is that each
 * thread has its own Event that it waits on when it is doing a ConditionWait;
 * it uses the same event for all condition variables because it only waits on
 * one at a time. Each condition variable has a queue of waiting threads, and
 * a mutex used to serialize access to this queue.
 *
 * Special thanks to David Nichols and Jim Davidson for advice on the
 * Condition Variable implementation.
 */

};
/*
 * The per-thread event and queue pointers.
 */

#if TCL_THREADS

typedef struct ThreadSpecificData {
    HANDLE condEvent;			/* Per-thread condition event */
    struct ThreadSpecificData *nextPtr;	/* Queue pointers */
    struct ThreadSpecificData *prevPtr;
    int flags;				/* See flags below */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#endif /* TCL_THREADS */
#if TCL_THREADS

/*
 * State bits for the thread.
 * WIN_THREAD_UNINIT		Uninitialized. Must be zero because of the way
 *				ThreadSpecificData is created.
 * WIN_THREAD_RUNNING		Running, not waiting.
 * WIN_THREAD_BLOCKED		Waiting, or trying to wait.
 */

#define WIN_THREAD_UNINIT	0x0
#define WIN_THREAD_RUNNING	0x1
#define WIN_THREAD_BLOCKED	0x2

/*
 * The per condition queue pointers and the Mutex used to serialize access to
 * the queue.
 */

typedef struct {
typedef struct Tcl_Condition_ {
    CRITICAL_SECTION condLock;	/* Lock to serialize queuing on the
				 * condition. */
    CONDITION_VARIABLE cv;
    struct ThreadSpecificData *firstPtr;	/* Queue pointers */
    struct ThreadSpecificData *lastPtr;
} WinCondition;

/*
 * Additions by AOL for specialized thread memory allocator.
 */

#endif /* TCL_THREADS */
#ifdef USE_THREAD_ALLOC
static DWORD tlsKey;

typedef struct {
    Tcl_Mutex	     tlock;
    CRITICAL_SECTION wlock;
} allocMutex;
#endif /* USE_THREAD_ALLOC */

/*
 * The per thread data passed from TclpThreadCreate
 * to TclWinThreadStart.
 */

typedef struct {
  LPTHREAD_START_ROUTINE lpStartAddress; /* Original startup routine */
  LPVOID lpParameter;		/* Original startup data */
  unsigned int fpControl;	/* Floating point control word from the
				 * main thread */
  HANDLE tHandle;		/* used to wait on thread completion */ 
# if defined(_MSC_VER) || defined(__MSVCRT__)
  unsigned
# else
  DWORD
# endif
    thread_id;		/* initialized but unused,
			possibly useful for debugging */ 
} WinThread;

/* assuming alignment constraints result in lsb being constant 0 */
# define	TCL_WIN_THREAD_JOIN_FLAG	((size_t) 1 << 0)

# define	TCL_WIN_THREAD_ID(PTR, JOINABLE)\
	    ((Tcl_ThreadId) ((sizeof ((PTR) - (WinThread *) 0),\
	    (size_t) (PTR)) | ((JOINABLE)? TCL_WIN_THREAD_JOIN_FLAG: 0)))

# define	TCL_WIN_THREAD_PTR(ID)\
	    ((WinThread *) ((sizeof ((ID) == (Tcl_ThreadId) 0),\
	    (size_t) (ID) & ~TCL_WIN_THREAD_JOIN_FLAG)))

# define	TCL_WIN_THREAD_JOINABLE(ID)\
	    (((sizeof ((ID) == (Tcl_ThreadId) 0),\
	    (size_t) (ID) & TCL_WIN_THREAD_JOIN_FLAG)))


/*
 *----------------------------------------------------------------------
 *
 * TclWinFailure --
 *
 *  	Call this when an unexpected WIN32 error occurs
 *
 * Does not return
 *
 *----------------------------------------------------------------------
 */

void TCL_NORETURN WINAPI
TclWinFailure (
    char const *const routine)
{
    Tcl_Panic ("%s failed, last error = %#x\n", routine, GetLastError ());
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinThreadStart --
 *
 *	This procedure is the entry point for all new threads created
157
158
159
160
161
162
163
164
165


166
167
168
169
170
171
172
173
174
175
176
177


178
179


180
181
182


183
184
185
186
187
188
189
141
142
143
144
145
146
147


148
149

150
151
152
153
154
155
156
157
158
159
160
161
162


163
164



165
166
167
168
169
170
171
172
173







-
-
+
+
-











+
+
-
-
+
+
-
-
-
+
+







 */

static DWORD WINAPI
TclWinThreadStart(
    LPVOID lpParameter)		/* The WinThread structure pointer passed
				 * from TclpThreadCreate */
{
    WinThread *winThreadPtr = (WinThread *) lpParameter;
    LPTHREAD_START_ROUTINE lpOrigStartAddress;
    WinThread *const winThreadPtr = (WinThread *) lpParameter;
    static DWORD result;
    LPVOID lpOrigParameter;

    if (!winThreadPtr) {
	return TCL_ERROR;
    }

    _controlfp(winThreadPtr->fpControl, _MCW_EM | _MCW_RC | 0x03000000 /* _MCW_DN */
#if !defined(_WIN64)
	    | _MCW_PC
#endif
    );

    if (!TlsSetValue (TclWinGlobals.tls_thread_id, winThreadPtr))
	TclWinFailure ("TlsSetValue");
    lpOrigStartAddress = winThreadPtr->lpStartAddress;
    lpOrigParameter = winThreadPtr->lpParameter;
    result = winThreadPtr->lpStartAddress (winThreadPtr->lpParameter);
    if (!winThreadPtr->tHandle)

    Tcl_Free(winThreadPtr);
    return lpOrigStartAddress(lpOrigParameter);
	TclpSysFree (winThreadPtr);
    return result;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadCreate --
 *
207
208
209
210
211
212
213
214



215
216
217
218
219
220
221
222
223
224
225
226
227
228

229
230
231


232
233
234

235




236

237
238

239
240
241
242
243
244
245












246
247
248





249
250
251
252
253
254
255
191
192
193
194
195
196
197

198
199
200
201
202
203
204






205
206
207

208
209
210

211
212
213
214

215

216
217
218
219
220
221
222

223







224
225
226
227
228
229
230
231
232
233
234
235
236


237
238
239
240
241
242
243
244
245
246
247
248







-
+
+
+




-
-
-
-
-
-



-
+


-
+
+


-
+
-
+
+
+
+

+

-
+
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
+
+

-
-
+
+
+
+
+







    size_t stackSize,		/* Size of stack for the new thread. */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
    WinThread *winThreadPtr;		/* Per-thread startup info */
    HANDLE tHandle;

    winThreadPtr = (WinThread *)Tcl_Alloc(sizeof(WinThread));
    winThreadPtr = (WinThread *) TclpSysAlloc (sizeof *winThreadPtr);
    if (!winThreadPtr)
	TclWinFailure ("memory allocation");
    winThreadPtr->lpStartAddress = (LPTHREAD_START_ROUTINE) proc;
    winThreadPtr->lpParameter = clientData;
    winThreadPtr->fpControl = _controlfp(0, 0);

    EnterCriticalSection(&joinLock);

    *idPtr = 0; /* must initialize as Tcl_Thread is a pointer and
                 * on WIN64 sizeof void* != sizeof unsigned
		 */

#if defined(_MSC_VER) || defined(__MSVCRT__)
    tHandle = (HANDLE) _beginthreadex(NULL, (unsigned) stackSize,
	    (Tcl_ThreadCreateProc*) TclWinThreadStart, winThreadPtr,
	    0, (unsigned *)idPtr);
	    0 /* flags */,  &winThreadPtr->thread_id);
#else
    tHandle = CreateThread(NULL, (DWORD) stackSize,
	    TclWinThreadStart, winThreadPtr, 0, (LPDWORD)idPtr);
	    TclWinThreadStart, winThreadPtr, 0 /* flags */,
	    &winThreadPtr->thread_id);
#endif

    if (tHandle == NULL) {
    if (!tHandle) {
	LeaveCriticalSection(&joinLock);
	TclpSysFree (winThreadPtr);
# if	1
	TclWinFailure ("CreateThread");
# else
	return TCL_ERROR;
# endif
    } else {
	if (flags & TCL_THREAD_JOINABLE) {
	if (!(flags & TCL_THREAD_JOINABLE)) {
	    TclRememberJoinableThread(*idPtr);
	}

	/*
	 * The only purpose of this is to decrement the reference count so the
	 * OS resources will be reacquired when the thread closes.
	 */
	    /*
	     * The only purpose of this is to decrement the reference count
	     * so the OS resources will be reacquired when the thread closes.
	     */
	    if (!CloseHandle (tHandle))
		TclWinFailure ("ClosseHandle");
	    /* note: the WIN32 OpenHandle() can be used to open a HANDLE
	    from the given threadID. However, if the thread
	    terminates with a HANDLE count of zero, the kernel may clean up
	    the thread, in particular its return status, immediately.
	    Hence, joining the thread requires keeping a HANDLE open
	    until the thread has been successfully joined. */ 

	CloseHandle(tHandle);
	LeaveCriticalSection(&joinLock);
	    tHandle = 0;
	}
	winThreadPtr->tHandle = tHandle;

	*idPtr = TCL_WIN_THREAD_ID (winThreadPtr, 0 != tHandle);
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
269
270
271
272
273
274
275


















276


277
278
279
280
281
282
283
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286

287
288
289
290
291
292
293
294
295







+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
-
+
+








int
Tcl_JoinThread(
    Tcl_ThreadId threadId,	/* Id of the thread to wait upon */
    int *result)		/* Reference to the storage the result of the
				 * thread we wait upon will be written into. */
{
    if (!TCL_WIN_THREAD_JOINABLE (threadId))
	return TCL_ERROR;

    WinThread *winThreadPtr = TCL_WIN_THREAD_PTR (threadId);
    HANDLE const tHandle = winThreadPtr->tHandle;
    switch (WaitForSingleObject (tHandle, INFINITE)) {
	DWORD exit_code;
    default:
	return TCL_ERROR;
    case WAIT_FAILED:
	TclWinFailure ("WaitForSingleObject");
    case WAIT_OBJECT_0:
	if (!GetExitCodeThread (tHandle, &exit_code))
	    TclWinFailure ("GetExitCodeThread");
	*result = exit_code;
	if (!CloseHandle (tHandle))
	    TclWinFailure ("CloseHandle");
	TclpSysFree (winThreadPtr);
    return TclJoinThread(threadId, result);
	return TCL_OK;
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
292
293
294
295
296
297
298
299
300
301
302






303
304
305
306
307
308
309
304
305
306
307
308
309
310




311
312
313
314
315
316
317
318
319
320
321
322
323







-
-
-
-
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
TclpThreadExit(
    int status)
{
    EnterCriticalSection(&joinLock);
    TclSignalExitThread(Tcl_GetCurrentThread(), status);
    LeaveCriticalSection(&joinLock);

    WinThread *winThreadPtr;
    if (winThreadPtr = (WinThread *) TlsGetValue (
	    TclWinGlobals.tls_thread_id)) {
	if (!winThreadPtr->tHandle)
	    TclpSysFree (winThreadPtr);
    }
#if defined(_MSC_VER) || defined(__MSVCRT__)
    _endthreadex((unsigned) status);
#else
    ExitThread((DWORD) status);
#endif
}

322
323
324
325
326
327
328







329
330



















































331
332
333
334
335
336
337
336
337
338
339
340
341
342
343
344
345
346
347
348
349


350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407







+
+
+
+
+
+
+
-
-
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+







 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
    WinThread *winThreadPtr;
    if (!(winThreadPtr = (WinThread *) TlsGetValue (
	    TclWinGlobals.tls_thread_id))) {
	if (ERROR_SUCCESS != GetLastError ())
	    TclWinFailure ("TlsGetValue in Tcl_GetCurrentThread");
	/* this is an initial thread */
	/* can't use TclAlloc, as the USE_THREAD_ALLOC per-thread allocator
    return (Tcl_ThreadId)INT2PTR(GetCurrentThreadId());
}
	calls Tcl_GetCurrentThread() */
	if (!(winThreadPtr = (WinThread *) TclpSysAlloc (sizeof *winThreadPtr)))
	    TclWinFailure ("memory allocation");
	winThreadPtr->tHandle = 0;
	winThreadPtr->thread_id = GetCurrentThreadId ();
	if (!TlsSetValue (TclWinGlobals.tls_thread_id, winThreadPtr))
	    TclWinFailure ("TlsSetValue");
    }
    return TCL_WIN_THREAD_ID (winThreadPtr, 0 != winThreadPtr->tHandle);
}

/*
 *----------------------------------------------------------------------
 *
 * TclWinInitOnce
 *
 *	Perform module initialization exactly once
 *	storage keys.
 *
 * Results:
 *	None.
 *
 *
 *----------------------------------------------------------------------
 */
static BOOL
TclWinInitOnce (
    INIT_ONCE *init_once,
    void *parameter,
    void *context)
{
    struct tclWinGlobals *const twg = parameter;

    InitializeCriticalSection(&twg->initLock);
    InitializeCriticalSection(&twg->globalLock);
    twg->tls_thread_id = TlsAlloc ();

#if TCL_THREADS
    InitializeCriticalSection(&twg->allocLock.crit);
    twg->allocLockPtr = &twg->allocLock;
#endif /* TCL_THREADS */

    return TRUE;
}

# define	TCL_WIN_INITIALIZE_ONCE()\
	InitOnceExecuteOnce (&TclWinGlobals.init_once,\
	    TclWinInitOnce,\
	    &TclWinGlobals,\
	    0)


/*
 *----------------------------------------------------------------------
 *
 * TclpInitLock
 *
 *	This procedure is used to grab a lock that serializes initialization
347
348
349
350
351
352
353
354

355
356
357
358
359
360
361

362
363
364
365
366
367

368
369
370
371
372
373
374
417
418
419
420
421
422
423

424







425






426
427
428
429
430
431
432
433







-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
    if (!initialized) {
    if (!TCL_WIN_INITIALIZE_ONCE ())
	/*
	 * 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.
	 */

	TclWinFailure ("InitOnceExecuteOnce");
	initialized = 1;
	InitializeCriticalSection(&joinLock);
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&globalLock);
    }
    EnterCriticalSection(&initLock);
    EnterCriticalSection(&TclWinGlobals.initLock);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpInitUnlock
 *
383
384
385
386
387
388
389
390

391
392
393
394
395
396
397
442
443
444
445
446
447
448

449
450
451
452
453
454
455
456







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpInitUnlock(void)
{
    LeaveCriticalSection(&initLock);
    LeaveCriticalSection(&TclWinGlobals.initLock);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGlobalLock
 *
409
410
411
412
413
414
415
416

417
418
419
420
421
422
423

424
425
426
427
428
429

430
431
432
433
434
435
436
468
469
470
471
472
473
474

475







476






477
478
479
480
481
482
483
484







-
+
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpGlobalLock(void)
{
    if (!initialized) {
    if (!TCL_WIN_INITIALIZE_ONCE ())
	/*
	 * 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.
	 */

	TclWinFailure ("InitOnceExecuteOnce");
	initialized = 1;
	InitializeCriticalSection(&joinLock);
	InitializeCriticalSection(&initLock);
	InitializeCriticalSection(&globalLock);
    }
    EnterCriticalSection(&globalLock);
    EnterCriticalSection(&TclWinGlobals.globalLock);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGlobalUnlock
 *
445
446
447
448
449
450
451
452

453
454
455
456
457
458
459
493
494
495
496
497
498
499

500
501
502
503
504
505
506
507







-
+







 *
 *----------------------------------------------------------------------
 */

void
TclpGlobalUnlock(void)
{
    LeaveCriticalSection(&globalLock);
    LeaveCriticalSection(&TclWinGlobals.globalLock);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetAllocMutex
 *
471
472
473
474
475
476
477
478

479
480

481
482

483
484
485
486
487
488
489
519
520
521
522
523
524
525

526


527


528
529
530
531
532
533
534
535







-
+
-
-
+
-
-
+







 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
    if (!allocOnce) {
    if (!TCL_WIN_INITIALIZE_ONCE ())
	InitializeCriticalSection(&allocLock.crit);
	allocOnce = 1;
	TclWinFailure ("InitOnceExecuteOnce");
    }
    return &allocLockPtr;
    return &TclWinGlobals.allocLockPtr;
#else
    return NULL;
#endif
}

/*
 *----------------------------------------------------------------------
502
503
504
505
506
507
508

509
510



511
512
513
514
515
516

517
518
519
520
521

522
523
524
525
526

527
528
529
530
531
532




533
534
535
536
537
538
539
540
541
542
543
544
545
548
549
550
551
552
553
554
555
556

557
558
559
560
561
562
563
564

565

566
567


568


569
570

571
572
573
574
575
576

577
578
579
580
581
582
583



584
585
586
587
588
589
590







+

-
+
+
+





-
+
-


-
-
+
-
-


-
+





-
+
+
+
+



-
-
-







 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
    struct tclWinGlobals *const twg = &TclWinGlobals;
    TclpGlobalLock();
    DeleteCriticalSection(&joinLock);

    if (!TlsFree (twg->tls_thread_id))
	TclWinFailure ("TlsFree");

    /*
     * Destroy the critical section that we are holding!
     */

    DeleteCriticalSection(&globalLock);
    DeleteCriticalSection(&twg->globalLock);
    initialized = 0;

#if TCL_THREADS
    if (allocOnce) {
	DeleteCriticalSection(&allocLock.crit);
    DeleteCriticalSection(&twg->allocLock.crit);
	allocOnce = 0;
    }
#endif

    LeaveCriticalSection(&initLock);
    LeaveCriticalSection(&twg->initLock);

    /*
     * Destroy the critical section that we were holding.
     */

    DeleteCriticalSection(&initLock);
    DeleteCriticalSection(&twg->initLock);

    InitOnceInitialize (&twg->init_once);	/* assuming we want to
	re-initialize at some point -- dubious */
}

#if TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(void *data);

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This is a self initializing
554
555
556
557
558
559
560
561

562
563
564
565
566
567

568
569
570
571
572
573



574
575
576
577
578
579

580
581
582
583
584
585
586
599
600
601
602
603
604
605

606
607
608
609
610
611
612
613
614
615
616



617
618
619
620
621
622
623


624
625
626
627
628
629
630
631







-
+






+



-
-
-
+
+
+




-
-
+







 *----------------------------------------------------------------------
 */

void
Tcl_MutexLock(
    Tcl_Mutex *mutexPtr)	/* The lock */
{
    CRITICAL_SECTION *csPtr;
    struct Tcl_Mutex_ *mp;

    if (*mutexPtr == NULL) {
	TclpGlobalLock();

	/*
	 * Double inside global lock check to avoid a race.
	 * BROKEN: does work in relaxed memory models
	 */

	if (*mutexPtr == NULL) {
	    csPtr = (CRITICAL_SECTION *)Tcl_Alloc(sizeof(CRITICAL_SECTION));
	    InitializeCriticalSection(csPtr);
	    *mutexPtr = (Tcl_Mutex)csPtr;
	    mp = Tcl_Alloc (sizeof *mp);
	    InitializeCriticalSection (&mp->crit);
	    *mutexPtr = mp;
	    TclRememberMutex(mutexPtr);
	}
	TclpGlobalUnlock();
    }
    csPtr = *((CRITICAL_SECTION **)mutexPtr);
    EnterCriticalSection(csPtr);
    EnterCriticalSection (&(*mutexPtr)->crit);
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexUnlock --
 *
595
596
597
598
599
600
601
602
603
604

605
606
607
608
609
610
611
640
641
642
643
644
645
646



647
648
649
650
651
652
653
654







-
-
-
+







 *----------------------------------------------------------------------
 */

void
Tcl_MutexUnlock(
    Tcl_Mutex *mutexPtr)	/* The lock */
{
    CRITICAL_SECTION *csPtr = *((CRITICAL_SECTION **)mutexPtr);

    LeaveCriticalSection(csPtr);
    LeaveCriticalSection (&(*mutexPtr)->crit);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeMutex --
 *
621
622
623
624
625
626
627
628
629

630
631
632


633
634
635
636
637
638
639
664
665
666
667
668
669
670


671



672
673
674
675
676
677
678
679
680







-
-
+
-
-
-
+
+







 *----------------------------------------------------------------------
 */

void
TclpFinalizeMutex(
    Tcl_Mutex *mutexPtr)
{
    CRITICAL_SECTION *csPtr = *(CRITICAL_SECTION **)mutexPtr;

    if (*mutexPtr) {
    if (csPtr != NULL) {
	DeleteCriticalSection(csPtr);
	Tcl_Free(csPtr);
	DeleteCriticalSection(&(*mutexPtr)->crit);
	Tcl_Free(*mutexPtr);
	*mutexPtr = NULL;
    }
}

/*
 *----------------------------------------------------------------------
 *
804
805
806
807
808
809
810
811
812


813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830


831

832
833

834
835
836

837
838
839
840
841
842
843


844
845

846
847
848
849

850
851
852
853
854
855
856
857
858
859
860
861
862

863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880

881
882
883
884
885
886

887
888
889
890
891
892
893
894
895
845
846
847
848
849
850
851


852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867




868
869

870
871

872



873







874
875


876




877













878


















879






880


881
882
883
884
885
886
887







-
-
+
+














-
-
-
-
+
+
-
+

-
+
-
-
-
+
-
-
-
-
-
-
-
+
+
-
-
+
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
+
-
-
-
-
-
-
+
-
-







/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionNotify --
 *
 *	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.
 *	The mutex does not need to be held during this call to avoid races
 *	and should not be, to minimize the number of context switches
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	May unblock another thread.
 *
 *----------------------------------------------------------------------
 */

void
Tcl_ConditionNotify(
    Tcl_Condition *condPtr)
{
    WinCondition *winCondPtr;
    ThreadSpecificData *tsdPtr;

    if (*condPtr != NULL) {
    /* double checked locking, i.e., BROKEN */
    if (*condPtr == NULL) {
	winCondPtr = *((WinCondition **)condPtr);
	TclpGlobalLock();

	if (winCondPtr == NULL) {
	if (*condPtr == NULL) {
	    return;
	}

	    WinCondition *winCondPtr;
	/*
	 * Loop through all the threads waiting on the condition and notify
	 * them (i.e., broadcast semantics). The queue manipulation is guarded
	 * by the per-condition coordinating mutex.
	 */

	EnterCriticalSection(&winCondPtr->condLock);
	    winCondPtr = (WinCondition *)Tcl_Alloc(sizeof *winCondPtr);
	    InitializeConditionVariable (&winCondPtr->cv);
	while (winCondPtr->firstPtr != NULL) {
	    tsdPtr = winCondPtr->firstPtr;
	    *condPtr = winCondPtr;
	    winCondPtr->firstPtr = tsdPtr->nextPtr;
	    if (winCondPtr->lastPtr == tsdPtr) {
		winCondPtr->lastPtr = NULL;
	    }
	}
	    tsdPtr->flags = WIN_THREAD_RUNNING;
	    tsdPtr->nextPtr = NULL;
	    tsdPtr->prevPtr = NULL;	/* Not strictly necessary, see A: */
	    SetEvent(tsdPtr->condEvent);
	}
	LeaveCriticalSection(&winCondPtr->condLock);
    } else {
	/*
	 * No-one has used the condition variable, so there are no waiters.
	 */
    }
}

	TclpGlobalUnlock();
/*
 *----------------------------------------------------------------------
 *
 * FinalizeConditionEvent --
 *
 *	This procedure is invoked to clean up the per-thread event used to
 *	implement condition waiting. This is only safe to call at the end of
 *	time.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	The per-thread event is closed.
 *
 *----------------------------------------------------------------------
 */

    }
static void
FinalizeConditionEvent(
    void *data)
{
    ThreadSpecificData *tsdPtr = (ThreadSpecificData *) data;

    WakeAllConditionVariable (&(*condPtr)->cv);
    tsdPtr->flags = WIN_THREAD_UNINIT;
    CloseHandle(tsdPtr->condEvent);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpFinalizeCondition --
 *
907
908
909
910
911
912
913
914

915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936







937
938
939
940
941
942
943
899
900
901
902
903
904
905

906
907
908
909
910
911
912
913
914
915

916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941







-
+









-












+
+
+
+
+
+
+







 *----------------------------------------------------------------------
 */

void
TclpFinalizeCondition(
    Tcl_Condition *condPtr)
{
    WinCondition *winCondPtr = *(WinCondition **)condPtr;
    WinCondition *winCondPtr = *condPtr;

    /*
     * Note - this is called long after the thread-local storage is reclaimed.
     * The per-thread condition waiting event is reclaimed earlier in a
     * per-thread exit handler, which is called before thread local storage is
     * reclaimed.
     */

    if (winCondPtr != NULL) {
	DeleteCriticalSection(&winCondPtr->condLock);
	Tcl_Free(winCondPtr);
	*condPtr = NULL;
    }
}




/*
 * Additions by AOL for specialized thread memory allocator.
 */
#ifdef USE_THREAD_ALLOC

static DWORD tlsKey;

typedef struct {
    Tcl_Mutex	     tlock;
    CRITICAL_SECTION wlock;
} allocMutex;

Tcl_Mutex *
TclpNewAllocMutex(void)
{
    allocMutex *lockPtr;

    lockPtr = (allocMutex *)malloc(sizeof(allocMutex));