Tcl Source Code

Check-in [3419afb49d]
Login

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

Overview
Comment:merge core-8-branch
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-500
Files: files | file ages | folders
SHA3-256:3419afb49d498e9786a6476230b2eb837b60b1978d5de30964dc46974f632ca8
User & Date: dkf 2018-06-02 14:19:33
Context
2018-06-03
11:44
TIP 500: Private Methods and Variables in TclOO check-in: 86262924a2 user: dkf tags: core-8-branch
2018-06-02
14:19
merge core-8-branch Closed-Leaf check-in: 3419afb49d user: dkf tags: tip-500
2018-05-31
07:17
Neither use --disable-threads on MacOS builds, and don't mention it any more in the README check-in: dade30b4a0 user: jan.nijtmans tags: core-8-branch
2018-05-30
09:38
Tweaking the documentation check-in: d65f77c5b5 user: dkf tags: tip-500
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to generic/tcl.h.

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
....
2555
2556
2557
2558
2559
2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
2584
2585
2586
2587
2588
2589
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#endif
#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif
#endif /* !TCL_NO_DEPRECATED */

#ifndef TCL_THREADS
#   define TCL_THREADS 1
#endif


/*
 * A special definition used to allow this header file to be included from
 * windows resource files so that they can obtain version information.
 * RC_INVOKED is defined by default by the windows RC tool.
 *
 * Resource compilers don't like all the C stuff, like typedefs and function
 * declarations, that occur below, so block them out.
 */

#ifndef RC_INVOKED

/*
 * Special macro to define mutexes, that doesn't do anything if we are not
 * using threads.
 */

#if !defined(TCL_THREADS) || TCL_THREADS
#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;
#else
#define TCL_DECLARE_MUTEX(name)
#endif

/*
 * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
 * SEEK_END, all #define'd by stdio.h .
 *
 * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h
 * providing it for them rather than #include-ing it themselves as they
................................................................................
#undef  Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#undef  Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)

/*
 *----------------------------------------------------------------------------
 * Macros that eliminate the overhead of the thread synchronization functions
 * when compiling without thread support.
 */

#if defined(TCL_THREADS) && !TCL_THREADS
#undef  Tcl_MutexLock
#define Tcl_MutexLock(mutexPtr)
#undef  Tcl_MutexUnlock
#define Tcl_MutexUnlock(mutexPtr)
#undef  Tcl_MutexFinalize
#define Tcl_MutexFinalize(mutexPtr)
#undef  Tcl_ConditionNotify
#define Tcl_ConditionNotify(condPtr)
#undef  Tcl_ConditionWait
#define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#undef  Tcl_ConditionFinalize
#define Tcl_ConditionFinalize(condPtr)
#endif /* !TCL_THREADS */

/*
 *----------------------------------------------------------------------------
 * Deprecated Tcl functions:
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*







<




>













|
<


<

<
<
<







 







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







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
....
2550
2551
2552
2553
2554
2555
2556





















2557
2558
2559
2560
2561
2562
2563
#  define STRINGIFY(x) STRINGIFY1(x)
#  define STRINGIFY1(x) #x
#endif
#ifndef JOIN
#  define JOIN(a,b) JOIN1(a,b)
#  define JOIN1(a,b) a##b
#endif


#ifndef TCL_THREADS
#   define TCL_THREADS 1
#endif
#endif /* !TCL_NO_DEPRECATED */

/*
 * A special definition used to allow this header file to be included from
 * windows resource files so that they can obtain version information.
 * RC_INVOKED is defined by default by the windows RC tool.
 *
 * Resource compilers don't like all the C stuff, like typedefs and function
 * declarations, that occur below, so block them out.
 */

#ifndef RC_INVOKED

/*
 * Special macro to define mutexes.

 */


#define TCL_DECLARE_MUTEX(name) static Tcl_Mutex name;




/*
 * Tcl's public routine Tcl_FSSeek() uses the values SEEK_SET, SEEK_CUR, and
 * SEEK_END, all #define'd by stdio.h .
 *
 * Also, many extensions need stdio.h, and they've grown accustomed to tcl.h
 * providing it for them rather than #include-ing it themselves as they
................................................................................
#undef  Tcl_FindHashEntry
#define Tcl_FindHashEntry(tablePtr, key) \
	(*((tablePtr)->findProc))(tablePtr, (const char *)(key))
#undef  Tcl_CreateHashEntry
#define Tcl_CreateHashEntry(tablePtr, key, newPtr) \
	(*((tablePtr)->createProc))(tablePtr, (const char *)(key), newPtr)






















/*
 *----------------------------------------------------------------------------
 * Deprecated Tcl functions:
 */

#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
/*

Changes to generic/tclAlloc.c.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

/*
 * Windows and Unix use an alternative allocator when building with threads
 * that has significantly reduced lock contention.
 */

#include "tclInt.h"
#if (defined(TCL_THREADS) && !TCL_THREADS) || !defined(USE_THREAD_ALLOC)

#if USE_TCLALLOC

/*
 * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
 * until Tcl uses config.h properly.
 */
................................................................................
/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Futhermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

#if !defined(TCL_THREADS) || TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;

#ifdef MSTATS

/*
................................................................................
 */

void
TclInitAlloc(void)
{
    if (!allocInit) {
	allocInit = 1;
#if !defined(TCL_THREADS) || TCL_THREADS
	allocMutexPtr = Tcl_GetAllocMutex();
#endif
    }
}
 
/*
 *-------------------------------------------------------------------------







|







 







|







 







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
...
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181

/*
 * Windows and Unix use an alternative allocator when building with threads
 * that has significantly reduced lock contention.
 */

#include "tclInt.h"
#if !TCL_THREADS || !defined(USE_THREAD_ALLOC)

#if USE_TCLALLOC

/*
 * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
 * until Tcl uses config.h properly.
 */
................................................................................
/*
 * The allocator is protected by a special mutex that must be explicitly
 * initialized. Futhermore, because Tcl_Alloc may be used before anything else
 * in Tcl, we make this module self-initializing after all with the allocInit
 * variable.
 */

#if TCL_THREADS
static Tcl_Mutex *allocMutexPtr;
#endif
static int allocInit = 0;

#ifdef MSTATS

/*
................................................................................
 */

void
TclInitAlloc(void)
{
    if (!allocInit) {
	allocInit = 1;
#if TCL_THREADS
	allocMutexPtr = Tcl_GetAllocMutex();
#endif
    }
}
 
/*
 *-------------------------------------------------------------------------

Changes to generic/tclBasic.c.

745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
...
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;
................................................................................
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
    TclpSetVariables(interp);

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
     * introspect on the interpreter level of thread safety.
     */








|







 







|







745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
...
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
    TclInitLimitSupport(interp);

    /*
     * Initialise the thread-specific data ekeko. Note that the thread's alloc
     * cache was already initialised by the call to alloc the interp struct.
     */

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    iPtr->allocCache = TclpGetAllocCache();
#else
    iPtr->allocCache = NULL;
#endif
    iPtr->pendingObjDataPtr = NULL;
    iPtr->asyncReadyPtr = TclGetAsyncReadyPtr();
    iPtr->deferredCallbacks = NULL;
................................................................................
#if !defined(TCL_NO_DEPRECATED) && TCL_MAJOR_VERSION < 9
    Tcl_TraceVar2(interp, "tcl_precision", NULL,
	    TCL_GLOBAL_ONLY|TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
	    TclPrecTraceProc, NULL);
#endif /* !TCL_NO_DEPRECATED */
    TclpSetVariables(interp);

#if TCL_THREADS
    /*
     * The existence of the "threaded" element of the tcl_platform array
     * indicates that this particular Tcl shell has been compiled with threads
     * turned on. Using "info exists tcl_platform(threaded)" a Tcl script can
     * introspect on the interpreter level of thread safety.
     */

Changes to generic/tclCkalloc.c.

152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

void
TclInitDbCkalloc(void)
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();
#if defined(TCL_THREADS) && !TCL_THREADS
	/* Silence compiler warning */
	(void)ckallocMutexPtr;
#endif
    }
}
 
/*







|







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166

void
TclInitDbCkalloc(void)
{
    if (!ckallocInit) {
	ckallocInit = 1;
	ckallocMutexPtr = Tcl_GetAllocMutex();
#if !TCL_THREADS
	/* Silence compiler warning */
	(void)ckallocMutexPtr;
#endif
    }
}
 
/*

Changes to generic/tclEvent.c.

96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
....
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
....
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
....
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
....
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
				 * thread. */
    int inExit;			/* True when this thread is exiting. This is
				 * used as a hack to decide to close the
				 * standard channels. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if !defined(TCL_THREADS) || TCL_THREADS
typedef struct {
    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
    ClientData clientData;	/* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
#endif /* TCL_THREADS */

................................................................................
	     */

	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)
	    TclInitThreadAlloc();	/* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
................................................................................

    TclFinalizeSynchronization();

    /*
     * Close down the thread-specific object allocator.
     */

#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)
    TclFinalizeThreadAlloc();
#endif

    /*
     * We defer unloading of packages until very late to avoid memory access
     * issues. Both exit callbacks and synchronization variables may be stored
     * in packages.
................................................................................
     * executed commands.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * NewThreadProc --
 *
 *	Bootstrap function of a new Tcl thread.
 *
................................................................................
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if !defined(TCL_THREADS) || TCL_THREADS
    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {







|







 







|







 







|







 







|







 







|







96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
....
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
....
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
....
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
....
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
				 * thread. */
    int inExit;			/* True when this thread is exiting. This is
				 * used as a hack to decide to close the
				 * standard channels. */
} ThreadSpecificData;
static Tcl_ThreadDataKey dataKey;

#if TCL_THREADS
typedef struct {
    Tcl_ThreadCreateProc *proc;	/* Main() function of the thread */
    ClientData clientData;	/* The one argument to Main() */
} ThreadClientData;
static Tcl_ThreadCreateType NewThreadProc(ClientData clientData);
#endif /* TCL_THREADS */

................................................................................
	     */

	    TclInitThreadStorage();     /* Creates master hash table for
					 * thread local storage */
#if USE_TCLALLOC
	    TclInitAlloc();		/* Process wide mutex init */
#endif
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
	    TclInitThreadAlloc();	/* Setup thread allocator caches */
#endif
#ifdef TCL_MEM_DEBUG
	    TclInitDbCkalloc();		/* Process wide mutex init */
#endif

	    TclpInitPlatform();		/* Creates signal handler(s) */
................................................................................

    TclFinalizeSynchronization();

    /*
     * Close down the thread-specific object allocator.
     */

#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    TclFinalizeThreadAlloc();
#endif

    /*
     * We defer unloading of packages until very late to avoid memory access
     * issues. Both exit callbacks and synchronization variables may be stored
     * in packages.
................................................................................
     * executed commands.
     */

    Tcl_ResetResult(interp);
    return TCL_OK;
}
 
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * NewThreadProc --
 *
 *	Bootstrap function of a new Tcl thread.
 *
................................................................................
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    ThreadClientData *cdPtr = ckalloc(sizeof(ThreadClientData));
    int result;

    cdPtr->proc = proc;
    cdPtr->clientData = clientData;
    result = TclpThreadCreate(idPtr, NewThreadProc, cdPtr, stackSize, flags);
    if (result != TCL_OK) {

Changes to generic/tclIORChan.c.

35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
...
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
...
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
...
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
...
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
...
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
....
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
....
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
....
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
....
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
....
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
....
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
....
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
....
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
....
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
....
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
....
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
....
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
....
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
....
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
....
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
			    Tcl_Interp *interp);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
#if !defined(TCL_THREADS) || TCL_THREADS
static void		ReflectThread(ClientData clientData, int action);
static int		ReflectEventRun(Tcl_Event *ev, int flags);
static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		ReflectSeek(ClientData clientData, long offset,
................................................................................
    ReflectWatch,	   /* Initialize notifier			  */
    NULL,		   /* Get OS handle from the channel.	NULL'able */
    NULL,		   /* No close2 support.		NULL'able */
    ReflectBlock,	   /* Set blocking/nonblocking.		NULL'able */
    NULL,		   /* Flush channel. Not used by core.	NULL'able */
    NULL,		   /* Handle events.			NULL'able */
    ReflectSeekWide,	   /* Move access point (64 bit).	NULL'able */
#if !defined(TCL_THREADS) || TCL_THREADS
    ReflectThread,         /* thread action, tracking owner */
#else
    NULL,		   /* thread action */
#endif
    NULL		   /* truncate */
};

................................................................................
				 * structure. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. NULL here
				 * signals the channel is dead because the
				 * interpreter/thread containing its Tcl
				 * command is gone.
				 */
#if !defined(TCL_THREADS) || TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
#endif
    Tcl_Obj *cmd;		/* Callback command prefix */
    Tcl_Obj *methods;		/* Methods to append to command prefix */
    Tcl_Obj *name;		/* Name of the channel as created */

................................................................................
#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

................................................................................
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#if !defined(TCL_THREADS) || TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost    = "{Owner lost}";
static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
 
/*
 * Main methods to plug into the 'chan' ensemble'. ==================
................................................................................
    rcmPtr = GetReflectedChannelMap(interp);
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
    }
    Tcl_SetHashValue(hPtr, chan);
#if !defined(TCL_THREADS) || TCL_THREADS
    rcmPtr = GetThreadReflectedChannelMap();
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    Tcl_SetHashValue(hPtr, chan);
#endif

    /*
................................................................................
 * Side effects:
 *	Posts events to a reflected channel, invokes event handlers. The
 *	latter implies that arbitrary side effects are possible.
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_THREADS) || TCL_THREADS
typedef struct {
    Tcl_Event header;
    ReflectedChannel *rcPtr;
    int events;
} ReflectEvent;

static int
................................................................................
	return TCL_ERROR;
    }

    /*
     * We have the channel and the events to post.
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
        Tcl_NotifyChannel(chan, events);
#if !defined(TCL_THREADS) || TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

................................................................................
	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#if !defined(TCL_THREADS) || TCL_THREADS
	if (rcPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	    result = p.base.code;

            /*
................................................................................
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	result = p.base.code;

        /*
................................................................................
	    rcmPtr = GetReflectedChannelMap(rcPtr->interp);
	    hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		    Tcl_GetChannelName(rcPtr->chan));
	    if (hPtr) {
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
#if !defined(TCL_THREADS) || TCL_THREADS
	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		Tcl_GetChannelName(rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
................................................................................
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.input.buf = buf;
	p.input.toRead = toRead;

	ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
................................................................................
    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.output.buf = buf;
	p.output.toWrite = toWrite;

	ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
................................................................................
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.seek.seekMode = seekMode;
	p.seek.offset = offset;

	ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
................................................................................
	return;
    }

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.watch.mask = mask;
	ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);

	/*
................................................................................
    int errorNum;		/* EINVAL or EOK (success). */
    Tcl_Obj *resObj;		/* Result data for 'blocking' */

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.block.nonblocking = nonblocking;

	ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);

................................................................................
    Tcl_DecrRefCount(blockObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */

    Tcl_Release(rcPtr);
    return errorNum;
}
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * ReflectThread --
 *
 *	This function is invoked to tell the channel about thread movements.
 *
................................................................................
    int result;			/* Result code for 'configure' */
    Tcl_Obj *resObj;		/* Result data for 'configure' */

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.setOpt.name = optionName;
	p.setOpt.value = newValue;

	ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
................................................................................
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	int opcode;
	ForwardParam p;

	p.getOpt.name = optionName;
	p.getOpt.value = dsPtr;

................................................................................
    rcPtr = ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
#if !defined(TCL_THREADS) || TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
................................................................................
{
    ReflectedChannelMap *rcmPtr = clientData;
				/* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedChannel *rcPtr;
    Tcl_Channel chan;
#if !defined(TCL_THREADS) || TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif

    /*
     * Delete all entries. The channels may have been closed already, or will
................................................................................

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    ckfree(&rcmPtr->map);

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this interpreter. While this is in progress we block any
................................................................................

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
#endif
}
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedChannelMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|



|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
...
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
...
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
...
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
...
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
...
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
....
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
....
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
....
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
....
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
....
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
....
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
....
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
....
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
....
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
....
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
....
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
....
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
....
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
....
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
....
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
			    Tcl_Interp *interp);
static int		ReflectInput(ClientData clientData, char *buf,
			    int toRead, int *errorCodePtr);
static int		ReflectOutput(ClientData clientData, const char *buf,
			    int toWrite, int *errorCodePtr);
static void		ReflectWatch(ClientData clientData, int mask);
static int		ReflectBlock(ClientData clientData, int mode);
#if TCL_THREADS
static void		ReflectThread(ClientData clientData, int action);
static int		ReflectEventRun(Tcl_Event *ev, int flags);
static int		ReflectEventDelete(Tcl_Event *ev, ClientData cd);
#endif
static Tcl_WideInt	ReflectSeekWide(ClientData clientData,
			    Tcl_WideInt offset, int mode, int *errorCodePtr);
static int		ReflectSeek(ClientData clientData, long offset,
................................................................................
    ReflectWatch,	   /* Initialize notifier			  */
    NULL,		   /* Get OS handle from the channel.	NULL'able */
    NULL,		   /* No close2 support.		NULL'able */
    ReflectBlock,	   /* Set blocking/nonblocking.		NULL'able */
    NULL,		   /* Flush channel. Not used by core.	NULL'able */
    NULL,		   /* Handle events.			NULL'able */
    ReflectSeekWide,	   /* Move access point (64 bit).	NULL'able */
#if TCL_THREADS
    ReflectThread,         /* thread action, tracking owner */
#else
    NULL,		   /* thread action */
#endif
    NULL		   /* truncate */
};

................................................................................
				 * structure. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. NULL here
				 * signals the channel is dead because the
				 * interpreter/thread containing its Tcl
				 * command is gone.
				 */
#if TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. == Handler thread */
    Tcl_ThreadId owner;         /* Thread owning the structure.    == Channel thread */
#endif
    Tcl_Obj *cmd;		/* Callback command prefix */
    Tcl_Obj *methods;		/* Methods to append to command prefix */
    Tcl_Obj *name;		/* Name of the channel as created */

................................................................................
#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))
 
#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

................................................................................
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_toomuch = "{read delivered more than requested}";
static const char *msg_write_toomuch = "{write wrote more than requested}";
static const char *msg_write_nothing = "{write wrote nothing}";
static const char *msg_seek_beforestart = "{Tried to seek before origin}";
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
#endif /* TCL_THREADS */
static const char *msg_send_dstlost    = "{Owner lost}";
static const char *msg_dstlost    = "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";
 
/*
 * Main methods to plug into the 'chan' ensemble'. ==================
................................................................................
    rcmPtr = GetReflectedChannelMap(interp);
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    if (!isNew && chanPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanCreateObjCmd: duplicate channel names");
    }
    Tcl_SetHashValue(hPtr, chan);
#if TCL_THREADS
    rcmPtr = GetThreadReflectedChannelMap();
    hPtr = Tcl_CreateHashEntry(&rcmPtr->map, chanPtr->state->channelName,
	    &isNew);
    Tcl_SetHashValue(hPtr, chan);
#endif

    /*
................................................................................
 * Side effects:
 *	Posts events to a reflected channel, invokes event handlers. The
 *	latter implies that arbitrary side effects are possible.
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
typedef struct {
    Tcl_Event header;
    ReflectedChannel *rcPtr;
    int events;
} ReflectEvent;

static int
................................................................................
	return TCL_ERROR;
    }

    /*
     * We have the channel and the events to post.
     */

#if TCL_THREADS
    if (rcPtr->owner == rcPtr->thread) {
#endif
        Tcl_NotifyChannel(chan, events);
#if TCL_THREADS
    } else {
        ReflectEvent *ev = ckalloc(sizeof(ReflectEvent));

        ev->header.proc = ReflectEventRun;
        ev->events = events;
        ev->rcPtr = rcPtr;

................................................................................
	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedChannelMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#if TCL_THREADS
	if (rcPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	    result = p.base.code;

            /*
................................................................................
	return EOK;
    }

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToHandlerThread(rcPtr, ForwardedClose, &p);
	result = p.base.code;

        /*
................................................................................
	    rcmPtr = GetReflectedChannelMap(rcPtr->interp);
	    hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		    Tcl_GetChannelName(rcPtr->chan));
	    if (hPtr) {
		Tcl_DeleteHashEntry(hPtr);
	    }
	}
#if TCL_THREADS
	rcmPtr = GetThreadReflectedChannelMap();
	hPtr = Tcl_FindHashEntry(&rcmPtr->map,
		Tcl_GetChannelName(rcPtr->chan));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
    }
................................................................................
    unsigned char *bytev;	/* Array of returned bytes */
    Tcl_Obj *resObj;		/* Result data for 'read' */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.input.buf = buf;
	p.input.toRead = toRead;

	ForwardOpToHandlerThread(rcPtr, ForwardedInput, &p);
................................................................................
    Tcl_Obj *resObj;		/* Result data for 'write' */
    int written;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.output.buf = buf;
	p.output.toWrite = toWrite;

	ForwardOpToHandlerThread(rcPtr, ForwardedOutput, &p);
................................................................................
    Tcl_Obj *resObj;		/* Result for 'seek' */
    Tcl_WideInt newLoc;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.seek.seekMode = seekMode;
	p.seek.offset = offset;

	ForwardOpToHandlerThread(rcPtr, ForwardedSeek, &p);
................................................................................
	return;
    }

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.watch.mask = mask;
	ForwardOpToHandlerThread(rcPtr, ForwardedWatch, &p);

	/*
................................................................................
    int errorNum;		/* EINVAL or EOK (success). */
    Tcl_Obj *resObj;		/* Result data for 'blocking' */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.block.nonblocking = nonblocking;

	ForwardOpToHandlerThread(rcPtr, ForwardedBlock, &p);

................................................................................
    Tcl_DecrRefCount(blockObj);
    Tcl_DecrRefCount(resObj);		/* Remove reference held from invoke */

    Tcl_Release(rcPtr);
    return errorNum;
}
 
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * ReflectThread --
 *
 *	This function is invoked to tell the channel about thread movements.
 *
................................................................................
    int result;			/* Result code for 'configure' */
    Tcl_Obj *resObj;		/* Result data for 'configure' */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.setOpt.name = optionName;
	p.setOpt.value = newValue;

	ForwardOpToHandlerThread(rcPtr, ForwardedSetOpt, &p);
................................................................................
    Tcl_Obj **listv;
    MethodName method;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rcPtr->thread != Tcl_GetCurrentThread()) {
	int opcode;
	ForwardParam p;

	p.getOpt.name = optionName;
	p.getOpt.value = dsPtr;

................................................................................
    rcPtr = ckalloc(sizeof(ReflectedChannel));

    /* rcPtr->chan: Assigned by caller. Dummy data here. */

    rcPtr->chan = NULL;
    rcPtr->interp = interp;
    rcPtr->dead = 0;
#if TCL_THREADS
    rcPtr->thread = Tcl_GetCurrentThread();
#endif
    rcPtr->mode = mode;
    rcPtr->interest = 0;		/* Initially no interest registered */

    /* ASSERT: cmdpfxObj is a Tcl List */
    rcPtr->cmd = TclListObjCopy(NULL, cmdpfxObj);
................................................................................
{
    ReflectedChannelMap *rcmPtr = clientData;
				/* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedChannel *rcPtr;
    Tcl_Channel chan;
#if TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif

    /*
     * Delete all entries. The channels may have been closed already, or will
................................................................................

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rcmPtr->map);
    ckfree(&rcmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Go through the list of pending results and cancel all whose events were
     * destined for this interpreter. While this is in progress we block any
................................................................................

	MarkDead(rcPtr);
	Tcl_DeleteHashEntry(hPtr);
    }
#endif
}
 
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedChannelMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.

Changes to generic/tclIORTrans.c.

123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
...
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
...
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
...
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
...
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
...
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
....
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
....
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
....
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
....
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
....
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
....
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
....
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
....
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
....
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
....
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
....
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
				 * was pushed on. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. */
    Tcl_Obj *handle;		/* Reference to transform handle. Also stored
				 * in the argv, see below. The separate field
				 * gives us direct access, needed when working
				 * with the reflection maps. */
#if !defined(TCL_THREADS) || TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
#endif

    Tcl_TimerToken timer;

    /* See [==] as well.
     * Storage for the command prefix and the additional words required for
................................................................................
#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

................................................................................
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#if !defined(TCL_THREADS) || TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
static const char *msg_dstlost =
    "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";

/*
................................................................................

    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#if !defined(TCL_THREADS) || TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
................................................................................
	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedTransformMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#if !defined(TCL_THREADS) || TCL_THREADS
	if (rtPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	    result = p.base.code;

	    if (result != TCL_OK) {
................................................................................
     * be called. for transformations however we are not going through here on
     * such an abort, but directly through FreeReflectedTransform. So for us
     * that check is not necessary. We always go through 'finalize'.
     */

    if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
	if (!TransformDrain(rtPtr, &errorCode)) {
#if !defined(TCL_THREADS) || TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
	    goto cleanup;
	}
    }

    if (HAS(rtPtr->methods, METH_FLUSH)) {
	if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
#if !defined(TCL_THREADS) || TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
................................................................................
	}
    }

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	result = p.base.code;

	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
................................................................................

	/*
	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#if !defined(TCL_THREADS) || TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }
................................................................................
    rtPtr = ckalloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if !defined(TCL_THREADS) || TCL_THREADS
    rtPtr->thread = Tcl_GetCurrentThread();
#endif
    rtPtr->parent = parentChan;
    rtPtr->interp = interp;
    rtPtr->handle = handleObj;
    Tcl_IncrRefCount(handleObj);
    rtPtr->timer = NULL;
................................................................................
    ClientData clientData,	/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    ReflectedTransformMap *rtmPtr; /* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedTransform *rtPtr;
#if !defined(TCL_THREADS) || TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif /* TCL_THREADS */

    /*
     * Delete all entries. The channels may have been closed already, or will
................................................................................

	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    ckfree(&rtmPtr->map);

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
................................................................................

	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rtForwardMutex);
#endif /* TCL_THREADS */
}
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedTransformMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.
................................................................................
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
................................................................................
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) buf;
	p.transform.size = toWrite;

	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
................................................................................
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
................................................................................
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
................................................................................
TransformClear(
    ReflectedTransform *rtPtr)
{
    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
	return;
    }
#endif /* TCL_THREADS */
................................................................................
    Tcl_Obj *resObj;
    Tcl_InterpState sr;		/* State of handler interp */

    /*
     * Are we in the correct thread?
     */

#if !defined(TCL_THREADS) || TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);







|







 







|







 







|







 







|







 







|







 







|













|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
...
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
...
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
...
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
...
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
...
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
...
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
....
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
....
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
....
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
....
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
....
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
....
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
....
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
....
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
....
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
....
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
....
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
				 * was pushed on. */
    Tcl_Interp *interp;		/* Reference to the interpreter containing the
				 * Tcl level part of the channel. */
    Tcl_Obj *handle;		/* Reference to transform handle. Also stored
				 * in the argv, see below. The separate field
				 * gives us direct access, needed when working
				 * with the reflection maps. */
#if TCL_THREADS
    Tcl_ThreadId thread;	/* Thread the 'interp' belongs to. */
#endif

    Tcl_TimerToken timer;

    /* See [==] as well.
     * Storage for the command prefix and the additional words required for
................................................................................
#define RANDW \
	(TCL_READABLE | TCL_WRITABLE)

#define IMPLIES(a,b)	((!(a)) || (b))
#define NEGIMPL(a,b)
#define HAS(x,f)	(x & FLAG(f))
 
#if TCL_THREADS
/*
 * Thread specific types and structures.
 *
 * We are here essentially creating a very specific implementation of 'thread
 * send'.
 */

................................................................................
 * These string are used directly as bypass errors, thus they have to be valid
 * Tcl lists where the last element is the message itself. Hence the
 * list-quoting to keep the words of the message together. See also [x].
 */

static const char *msg_read_unsup = "{read not supported by Tcl driver}";
static const char *msg_write_unsup = "{write not supported by Tcl driver}";
#if TCL_THREADS
static const char *msg_send_originlost = "{Channel thread lost}";
static const char *msg_send_dstlost = "{Owner lost}";
#endif /* TCL_THREADS */
static const char *msg_dstlost =
    "-code 1 -level 0 -errorcode NONE -errorinfo {} -errorline 1 {Owner lost}";

/*
................................................................................

    rtmPtr = GetReflectedTransformMap(interp);
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    if (!isNew && rtPtr != Tcl_GetHashValue(hPtr)) {
	Tcl_Panic("TclChanPushObjCmd: duplicate transformation handle");
    }
    Tcl_SetHashValue(hPtr, rtPtr);
#if TCL_THREADS
    rtmPtr = GetThreadReflectedTransformMap();
    hPtr = Tcl_CreateHashEntry(&rtmPtr->map, TclGetString(rtId), &isNew);
    Tcl_SetHashValue(hPtr, rtPtr);
#endif /* TCL_THREADS */

    /*
     * Return the channel as the result of the command.
................................................................................
	 * THREADED => Forward this to the origin thread
	 *
	 * Note: DeleteThreadReflectedTransformMap() is the thread exit handler
	 * for the origin thread. Use this to clean up the structure? Except
	 * if lost?
	 */

#if TCL_THREADS
	if (rtPtr->thread != Tcl_GetCurrentThread()) {
	    ForwardParam p;

	    ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	    result = p.base.code;

	    if (result != TCL_OK) {
................................................................................
     * be called. for transformations however we are not going through here on
     * such an abort, but directly through FreeReflectedTransform. So for us
     * that check is not necessary. We always go through 'finalize'.
     */

    if (HAS(rtPtr->methods, METH_DRAIN) && !rtPtr->readIsDrained) {
	if (!TransformDrain(rtPtr, &errorCode)) {
#if TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
	    goto cleanup;
	}
    }

    if (HAS(rtPtr->methods, METH_FLUSH)) {
	if (!TransformFlush(rtPtr, &errorCode, FLUSH_WRITE)) {
#if TCL_THREADS
	    if (rtPtr->thread != Tcl_GetCurrentThread()) {
		Tcl_EventuallyFree(rtPtr,
			(Tcl_FreeProc *) FreeReflectedTransform);
		return errorCode;
	    }
#endif /* TCL_THREADS */
	    errorCodeSet = 1;
................................................................................
	}
    }

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClose, &p);
	result = p.base.code;

	Tcl_EventuallyFree(rtPtr, (Tcl_FreeProc *) FreeReflectedTransform);
................................................................................

	/*
	 * In a threaded interpreter we manage a per-thread map as well,
	 * to allow us to survive if the script level pulls the rug out
	 * under a channel by deleting the owning thread.
	 */

#if TCL_THREADS
	rtmPtr = GetThreadReflectedTransformMap();
	hPtr = Tcl_FindHashEntry(&rtmPtr->map, TclGetString(rtPtr->handle));
	if (hPtr) {
	    Tcl_DeleteHashEntry(hPtr);
	}
#endif /* TCL_THREADS */
    }
................................................................................
    rtPtr = ckalloc(sizeof(ReflectedTransform));

    /* rtPtr->chan: Assigned by caller. Dummy data here. */
    /* rtPtr->methods: Assigned by caller. Dummy data here. */

    rtPtr->chan = NULL;
    rtPtr->methods = 0;
#if TCL_THREADS
    rtPtr->thread = Tcl_GetCurrentThread();
#endif
    rtPtr->parent = parentChan;
    rtPtr->interp = interp;
    rtPtr->handle = handleObj;
    Tcl_IncrRefCount(handleObj);
    rtPtr->timer = NULL;
................................................................................
    ClientData clientData,	/* The per-interpreter data structure. */
    Tcl_Interp *interp)		/* The interpreter being deleted. */
{
    ReflectedTransformMap *rtmPtr; /* The map */
    Tcl_HashSearch hSearch;	 /* Search variable. */
    Tcl_HashEntry *hPtr;	 /* Search variable. */
    ReflectedTransform *rtPtr;
#if TCL_THREADS
    ForwardingResult *resultPtr;
    ForwardingEvent *evPtr;
    ForwardParam *paramPtr;
#endif /* TCL_THREADS */

    /*
     * Delete all entries. The channels may have been closed already, or will
................................................................................

	rtPtr->dead = 1;
	Tcl_DeleteHashEntry(hPtr);
    }
    Tcl_DeleteHashTable(&rtmPtr->map);
    ckfree(&rtmPtr->map);

#if TCL_THREADS
    /*
     * The origin interpreter for one or more reflected channels is gone.
     */

    /*
     * Get the map of all channels handled by the current thread. This is a
     * ReflectedTransformMap, but on a per-thread basis, not per-interp. Go
................................................................................

	Tcl_ConditionNotify(&resultPtr->done);
    }
    Tcl_MutexUnlock(&rtForwardMutex);
#endif /* TCL_THREADS */
}
 
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * GetThreadReflectedTransformMap --
 *
 *	Gets and potentially initializes the reflected channel map for a
 *	thread.
................................................................................
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) Tcl_GetByteArrayFromObj(bufObj,
		&(p.transform.size));

	ForwardOpToOwnerThread(rtPtr, ForwardedInput, &p);
................................................................................
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	p.transform.buf = (char *) buf;
	p.transform.size = toWrite;

	ForwardOpToOwnerThread(rtPtr, ForwardedOutput, &p);
................................................................................
    int bytec;			/* Number of returned bytes */
    unsigned char *bytev;	/* Array of returned bytes */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedDrain, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
................................................................................
    unsigned char *bytev;	/* Array of returned bytes */
    int res;

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedFlush, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);
................................................................................
TransformClear(
    ReflectedTransform *rtPtr)
{
    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedClear, &p);
	return;
    }
#endif /* TCL_THREADS */
................................................................................
    Tcl_Obj *resObj;
    Tcl_InterpState sr;		/* State of handler interp */

    /*
     * Are we in the correct thread?
     */

#if TCL_THREADS
    if (rtPtr->thread != Tcl_GetCurrentThread()) {
	ForwardParam p;

	ForwardOpToOwnerThread(rtPtr, ForwardedLimit, &p);

	if (p.base.code != TCL_OK) {
	    PassReceivedError(rtPtr->chan, &p);

Changes to generic/tclInt.h.

132
133
134
135
136
137
138




















139
140
141
142
143
144
145
....
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
....
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
....
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
#   endif
#endif

#if defined(_WIN32) && defined(_MSC_VER)
#   define vsnprintf _vsnprintf
#endif





















/*
 * The following procedures allow namespaces to be customized to support
 * special name resolution rules for commands/variables.
 */

struct Tcl_ResolvedVarInfo;

................................................................................
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

#if (!defined(TCL_THREADS) || TCL_THREADS) && !defined(USE_THREAD_ALLOC)
#   define USE_THREAD_ALLOC 1
#endif

#if defined(PURIFY)

/*
 * The PURIFY mode is like the regular mode, but instead of doing block
................................................................................
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree(objPtr)

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
 * per-thread caches.
 */

MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
................................................................................
#if defined(USE_TCLALLOC) && USE_TCLALLOC
    MODULE_SCOPE void TclFinalizeAllocSubsystem();
    MODULE_SCOPE void TclInitAlloc();
#else
#   define USE_TCLALLOC 0
#endif

#if !defined(TCL_THREADS) || TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex	tclObjMutex;
#endif

#  define TclAllocObjStorageEx(interp, objPtr) \
    do {								\
	Tcl_MutexLock(&tclObjMutex);					\







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







|







 







|







 







|







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
....
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
....
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
....
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
#   endif
#endif

#if defined(_WIN32) && defined(_MSC_VER)
#   define vsnprintf _vsnprintf
#endif

#if !defined(TCL_THREADS)
#   define TCL_THREADS 1
#endif
#if !TCL_THREADS
#   undef TCL_DECLARE_MUTEX
#   define TCL_DECLARE_MUTEX(name)
#   undef  Tcl_MutexLock
#   define Tcl_MutexLock(mutexPtr)
#   undef  Tcl_MutexUnlock
#   define Tcl_MutexUnlock(mutexPtr)
#   undef  Tcl_MutexFinalize
#   define Tcl_MutexFinalize(mutexPtr)
#   undef  Tcl_ConditionNotify
#   define Tcl_ConditionNotify(condPtr)
#   undef  Tcl_ConditionWait
#   define Tcl_ConditionWait(condPtr, mutexPtr, timePtr)
#   undef  Tcl_ConditionFinalize
#   define Tcl_ConditionFinalize(condPtr)
#endif

/*
 * The following procedures allow namespaces to be customized to support
 * special name resolution rules for commands/variables.
 */

struct Tcl_ResolvedVarInfo;

................................................................................
	    TclFreeObjStorage(objPtr); \
	    TclIncrObjsFreed(); \
	} else { \
	    TclFreeObj(objPtr); \
	} \
    }

#if TCL_THREADS && !defined(USE_THREAD_ALLOC)
#   define USE_THREAD_ALLOC 1
#endif

#if defined(PURIFY)

/*
 * The PURIFY mode is like the regular mode, but instead of doing block
................................................................................
	(objPtr) = (Tcl_Obj *) ckalloc(sizeof(Tcl_Obj))

#  define TclFreeObjStorageEx(interp, objPtr) \
	ckfree(objPtr)

#undef USE_THREAD_ALLOC
#undef USE_TCLALLOC
#elif TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * The TCL_THREADS mode is like the regular mode but allocates Tcl_Obj's from
 * per-thread caches.
 */

MODULE_SCOPE Tcl_Obj *	TclThreadAllocObj(void);
................................................................................
#if defined(USE_TCLALLOC) && USE_TCLALLOC
    MODULE_SCOPE void TclFinalizeAllocSubsystem();
    MODULE_SCOPE void TclInitAlloc();
#else
#   define USE_TCLALLOC 0
#endif

#if TCL_THREADS
/* declared in tclObj.c */
MODULE_SCOPE Tcl_Mutex	tclObjMutex;
#endif

#  define TclAllocObjStorageEx(interp, objPtr) \
    do {								\
	Tcl_MutexLock(&tclObjMutex);					\

Changes to generic/tclObj.c.

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
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
...
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
....
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
....
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
....
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
....
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
....
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
....
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
Tcl_Obj *tclFreeObjList = NULL;

/*
 * The object allocator is single threaded. This mutex is referenced by the
 * TclNewObj macro, however, so must be visible.
 */

#if !defined(TCL_THREADS) || TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

char tclEmptyString = '\0';

#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(TCL_MEM_DEBUG)
/*
 * Structure for tracking the source file and line number where a given
 * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
 * for sanity checking purposes.
 */

typedef struct ObjData {
................................................................................
                                 * any. I.e. this table keeps track of
                                 * invisible and stripped continuation lines.
                                 * Its keys are Tcl_Obj pointers, the values
                                 * are ContLineLoc pointers. See the file
                                 * tclCompile.h for the definition of this
                                 * structure, and for references to all
                                 * related places in the core. */
#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(TCL_MEM_DEBUG)
    Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
                                 * that a Tcl_Obj was not allocated by some
                                 * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
................................................................................
#define PopObjToDelete(contextPtr,objPtrVar) \
    (objPtrVar) = (contextPtr)->deletionStack;                          \
    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes

/*
 * Macro to set up the local reference to the deletion context.
 */
#if defined(TCL_THREADS) && !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#elif HAVE_FAST_TSD
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadObjects(void)
{
#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(TCL_MEM_DEBUG)
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
................................................................................
 *--------------------------------------------------------------
 */

void
TclDbDumpActiveObjects(
    FILE *outFile)
{
#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(TCL_MEM_DEBUG)
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

................................................................................
				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->bytes = &tclEmptyString;
    objPtr->length = 0;
    objPtr->typePtr = NULL;

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */

    if (!TclInExit()) {
	Tcl_HashEntry *hPtr;
................................................................................

    /*
     * This macro declares a variable, so must come here...
     */

    ObjInitDeletionContext(context);

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
................................................................................
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("incrementing refCount of previously disposed object");
    }

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
................................................................................
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("decrementing refCount of previously disposed object");
    }

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
................................................................................
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("checking whether previously disposed object is shared");
    }

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {







|












|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







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
..
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
...
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
...
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
....
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
....
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
....
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
....
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
....
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
....
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
Tcl_Obj *tclFreeObjList = NULL;

/*
 * The object allocator is single threaded. This mutex is referenced by the
 * TclNewObj macro, however, so must be visible.
 */

#if TCL_THREADS
MODULE_SCOPE Tcl_Mutex tclObjMutex;
Tcl_Mutex tclObjMutex;
#endif

/*
 * Pointer to a heap-allocated string of length zero that the Tcl core uses as
 * the value of an empty string representation for an object. This value is
 * shared by all new objects allocated by Tcl_NewObj.
 */

char tclEmptyString = '\0';

#if TCL_THREADS && defined(TCL_MEM_DEBUG)
/*
 * Structure for tracking the source file and line number where a given
 * Tcl_Obj was allocated.  We also track the pointer to the Tcl_Obj itself,
 * for sanity checking purposes.
 */

typedef struct ObjData {
................................................................................
                                 * any. I.e. this table keeps track of
                                 * invisible and stripped continuation lines.
                                 * Its keys are Tcl_Obj pointers, the values
                                 * are ContLineLoc pointers. See the file
                                 * tclCompile.h for the definition of this
                                 * structure, and for references to all
                                 * related places in the core. */
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
    Tcl_HashTable *objThreadMap;/* Thread local table that is used to check
                                 * that a Tcl_Obj was not allocated by some
                                 * other thread. */
#endif /* TCL_MEM_DEBUG && TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
................................................................................
#define PopObjToDelete(contextPtr,objPtrVar) \
    (objPtrVar) = (contextPtr)->deletionStack;                          \
    (contextPtr)->deletionStack = (Tcl_Obj *) (objPtrVar)->bytes

/*
 * Macro to set up the local reference to the deletion context.
 */
#if !TCL_THREADS
static PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
#elif HAVE_FAST_TSD
static __thread PendingObjData pendingObjData;
#define ObjInitDeletionContext(contextPtr) \
    PendingObjData *const contextPtr = &pendingObjData
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadObjects(void)
{
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
    Tcl_HashEntry *hPtr;
    Tcl_HashSearch hSearch;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    Tcl_HashTable *tablePtr = tsdPtr->objThreadMap;

    if (tablePtr != NULL) {
	for (hPtr = Tcl_FirstHashEntry(tablePtr, &hSearch);
................................................................................
 *--------------------------------------------------------------
 */

void
TclDbDumpActiveObjects(
    FILE *outFile)
{
#if TCL_THREADS && defined(TCL_MEM_DEBUG)
    Tcl_HashSearch hSearch;
    Tcl_HashEntry *hPtr;
    Tcl_HashTable *tablePtr;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

    tablePtr = tsdPtr->objThreadMap;

................................................................................
				 * debugging. */
{
    objPtr->refCount = 0;
    objPtr->bytes = &tclEmptyString;
    objPtr->length = 0;
    objPtr->typePtr = NULL;

#if TCL_THREADS
    /*
     * Add entry to a thread local map used to check if a Tcl_Obj was
     * allocated by the currently executing thread.
     */

    if (!TclInExit()) {
	Tcl_HashEntry *hPtr;
................................................................................

    /*
     * This macro declares a variable, so must come here...
     */

    ObjInitDeletionContext(context);

#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
................................................................................
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("incrementing refCount of previously disposed object");
    }

#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
................................................................................
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("decrementing refCount of previously disposed object");
    }

#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {
................................................................................
#ifdef TCL_MEM_DEBUG
    if (objPtr->refCount == 0x61616161) {
	fprintf(stderr, "file = %s, line = %d\n", file, line);
	fflush(stderr);
	Tcl_Panic("checking whether previously disposed object is shared");
    }

#if TCL_THREADS
    /*
     * Check to make sure that the Tcl_Obj was allocated by the current
     * thread. Don't do this check when shutting down since thread local
     * storage can be finalized before the last Tcl_Obj is freed.
     */

    if (!TclInExit()) {

Changes to generic/tclPanic.c.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
41
42
43
44
45
46
47

48
49
50
51
52
53
54

/*
 * The panicProc variable contains a pointer to an application specific panic
 * procedure.
 */

#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */


void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if ((proc != tclWinDebugPanic) || (panicProc == NULL))







|







 







>







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
..
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55

/*
 * The panicProc variable contains a pointer to an application specific panic
 * procedure.
 */

#if defined(__CYGWIN__) || (defined(_WIN32) && (defined(TCL_NO_DEPRECATED) || TCL_MAJOR_VERSION > 8))
static TCL_NORETURN1 Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static TCL_NORETURN1 Tcl_PanicProc *panicProc = NULL;
#endif
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 * Side effects:
 *	Sets the panicProc variable.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_SetPanicProc
void
Tcl_SetPanicProc(
    TCL_NORETURN1 Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if ((proc != tclWinDebugPanic) || (panicProc == NULL))

Changes to generic/tclPkgConfig.c.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#include "tclInt.h"
 
/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#if !defined(TCL_THREADS) || TCL_THREADS
#  define  CFG_THREADED		"1"
#else
#  define  CFG_THREADED		"0"
#endif

#ifdef TCL_MEM_DEBUG
#  define CFG_MEMDEBUG		"1"







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#include "tclInt.h"
 
/*
 * Use C preprocessor statements to define the various values for the embedded
 * configuration information.
 */

#if TCL_THREADS
#  define  CFG_THREADED		"1"
#else
#  define  CFG_THREADED		"0"
#endif

#ifdef TCL_MEM_DEBUG
#  define CFG_MEMDEBUG		"1"

Changes to generic/tclStubInit.c.

36
37
38
39
40
41
42

43
44
45
46
47
48
49
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable

#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt







>







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
#undef Tcl_SetPanicProc
#undef TclpGetPid
#undef TclSockMinimumBuffers
#undef Tcl_SetIntObj
#undef Tcl_SetLongObj
#undef TclpInetNtoa
#undef TclWinGetServByName
#undef TclWinGetSockOpt

Changes to generic/tclTest.c.

157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
...
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
...
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		AsyncHandlerProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
#if !defined(TCL_THREADS) || TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
static void		CleanupTestSetassocdataTests(
			    ClientData clientData, Tcl_Interp *interp);
static void		CmdDelProc1(ClientData clientData);
static void		CmdDelProc2(ClientData clientData);
static int		CmdProc1(ClientData clientData,
................................................................................

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#if !defined(TCL_THREADS) || TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
................................................................................
		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
#if !defined(TCL_THREADS) || TCL_THREADS
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
................................................................................
 *
 * Side effects:
 *	Invokes Tcl_AsyncMark on the handler
 *
 *----------------------------------------------------------------------
 */

#if !defined(TCL_THREADS) || TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
    ClientData clientData)	/* Parameter is the id of a
				 * TestAsyncHandler, defined above. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);







|







 







|







 







|







 







|







157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
...
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
...
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
...
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009

/*
 * Forward declarations for procedures defined later in this file:
 */

static int		AsyncHandlerProc(ClientData clientData,
			    Tcl_Interp *interp, int code);
#if TCL_THREADS
static Tcl_ThreadCreateType AsyncThreadProc(ClientData);
#endif
static void		CleanupTestSetassocdataTests(
			    ClientData clientData, Tcl_Interp *interp);
static void		CmdDelProc1(ClientData clientData);
static void		CmdDelProc2(ClientData clientData);
static int		CmdProc1(ClientData clientData,
................................................................................

    if (TclObjTest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
    if (Procbodytest_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#if TCL_THREADS
    if (TclThread_Init(interp) != TCL_OK) {
	return TCL_ERROR;
    }
#endif

    /*
     * Check for special options used in ../tests/main.test
................................................................................
		Tcl_AsyncMark(asyncPtr->handler);
		break;
	    }
	}
	Tcl_SetObjResult(interp, Tcl_NewStringObj(argv[3], -1));
	Tcl_MutexUnlock(&asyncTestMutex);
	return code;
#if TCL_THREADS
    } else if (strcmp(argv[1], "marklater") == 0) {
	if (argc != 3) {
	    goto wrongNumArgs;
	}
	if (Tcl_GetInt(interp, argv[2], &id) != TCL_OK) {
	    return TCL_ERROR;
	}
................................................................................
 *
 * Side effects:
 *	Invokes Tcl_AsyncMark on the handler
 *
 *----------------------------------------------------------------------
 */

#if TCL_THREADS
static Tcl_ThreadCreateType
AsyncThreadProc(
    ClientData clientData)	/* Parameter is the id of a
				 * TestAsyncHandler, defined above. */
{
    TestAsyncHandler *asyncPtr;
    int id = PTR2INT(clientData);

Changes to generic/tclThread.c.

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
..
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
...
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
...
265
266
267
268
269
270
271

272
273
274
275
276
277
278
279
280
281
282
283
...
318
319
320
321
322
323
324

325
326
327
328
329
330
331
332
333
334
335
336
...
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
...
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
...
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
...
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
 * Prototypes of functions used only in this file.
 */

static void		ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr);
static void		RememberSyncObject(void *objPtr,
			    SyncObjRecord *recPtr);

/*
 * Several functions are #defined to nothing in tcl.h if TCL_THREADS is not
 * specified. Here we undo that so the functions are defined in the stubs
 * table.
 */

#if defined(TCL_THREADS) && !TCL_THREADS
#undef Tcl_MutexLock
#undef Tcl_MutexUnlock
#undef Tcl_MutexFinalize
#undef Tcl_ConditionNotify
#undef Tcl_ConditionWait
#undef Tcl_ConditionFinalize
#endif
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetThreadData --
 *
 *	This function allocates and initializes a chunk of thread local
 *	storage.
................................................................................

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    int size)			/* Size of storage block */
{
    void *result;
#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
................................................................................
 */

void *
TclThreadDataKeyGet(
    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk. */

{
#if !defined(TCL_THREADS) || TCL_THREADS
    return TclThreadStorageKeyGet(keyPtr);
#else /* TCL_THREADS */
    return *keyPtr;
#endif /* TCL_THREADS */
}
 
/*
................................................................................
 *
 * Side effects:
 *	Remove the mutex from the list.
 *
 *----------------------------------------------------------------------
 */


void
Tcl_MutexFinalize(
    Tcl_Mutex *mutexPtr)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    TclpFinalizeMutex(mutexPtr);
#endif
    TclpMasterLock();
    ForgetSyncObject(mutexPtr, &mutexRecord);
    TclpMasterUnlock();
}
 
................................................................................
 *
 * Side effects:
 *	Remove the condition variable from the list.
 *
 *----------------------------------------------------------------------
 */


void
Tcl_ConditionFinalize(
    Tcl_Condition *condPtr)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    TclpFinalizeCondition(condPtr);
#endif
    TclpMasterLock();
    ForgetSyncObject(condPtr, &condRecord);
    TclpMasterUnlock();
}
 
................................................................................
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadData(int quick)
{
    TclFinalizeThreadDataThread();
#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)
    if (!quick) {
	/*
	 * Quick exit principle makes it useless to terminate allocators
	 */
	TclFinalizeThreadAllocThread();
    }
#endif
................................................................................

void
TclFinalizeSynchronization(void)
{
    int i;
    void *blockPtr;
    Tcl_ThreadDataKey *keyPtr;
#if !defined(TCL_THREADS) || TCL_THREADS
    Tcl_Mutex *mutexPtr;
    Tcl_Condition *condPtr;

    TclpMasterLock();
#endif

    /*
................................................................................
	}
	ckfree(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * Call thread storage master cleanup.
     */

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
................................................................................
 */

void
Tcl_ExitThread(
    int status)
{
    Tcl_FinalizeThread();
#if !defined(TCL_THREADS) || TCL_THREADS
    TclpThreadExit(status);
#endif
}

#if defined(TCL_THREADS) && !TCL_THREADS
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait, et al. --
 *
 *	These noop functions are provided so the stub table does not have to







<
<
<
<
<
<
<
<
<
<
<
<
<
<
<







 







|







 







|







 







>




|







 







>




|







 







|







 







|







 







|







 







<

<


|







36
37
38
39
40
41
42















43
44
45
46
47
48
49
..
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
...
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
...
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
...
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
...
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
...
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
...
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
...
456
457
458
459
460
461
462

463

464
465
466
467
468
469
470
471
472
473
 * Prototypes of functions used only in this file.
 */

static void		ForgetSyncObject(void *objPtr, SyncObjRecord *recPtr);
static void		RememberSyncObject(void *objPtr,
			    SyncObjRecord *recPtr);
















/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetThreadData --
 *
 *	This function allocates and initializes a chunk of thread local
 *	storage.
................................................................................

void *
Tcl_GetThreadData(
    Tcl_ThreadDataKey *keyPtr,	/* Identifier for the data chunk */
    int size)			/* Size of storage block */
{
    void *result;
#if TCL_THREADS
    /*
     * Initialize the key for this thread.
     */

    result = TclThreadStorageKeyGet(keyPtr);

    if (result == NULL) {
................................................................................
 */

void *
TclThreadDataKeyGet(
    Tcl_ThreadDataKey *keyPtr)	/* Identifier for the data chunk. */

{
#if TCL_THREADS
    return TclThreadStorageKeyGet(keyPtr);
#else /* TCL_THREADS */
    return *keyPtr;
#endif /* TCL_THREADS */
}
 
/*
................................................................................
 *
 * Side effects:
 *	Remove the mutex from the list.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_MutexFinalize
void
Tcl_MutexFinalize(
    Tcl_Mutex *mutexPtr)
{
#if TCL_THREADS
    TclpFinalizeMutex(mutexPtr);
#endif
    TclpMasterLock();
    ForgetSyncObject(mutexPtr, &mutexRecord);
    TclpMasterUnlock();
}
 
................................................................................
 *
 * Side effects:
 *	Remove the condition variable from the list.
 *
 *----------------------------------------------------------------------
 */

#undef Tcl_ConditionFinalize
void
Tcl_ConditionFinalize(
    Tcl_Condition *condPtr)
{
#if TCL_THREADS
    TclpFinalizeCondition(condPtr);
#endif
    TclpMasterLock();
    ForgetSyncObject(condPtr, &condRecord);
    TclpMasterUnlock();
}
 
................................................................................
 *----------------------------------------------------------------------
 */

void
TclFinalizeThreadData(int quick)
{
    TclFinalizeThreadDataThread();
#if TCL_THREADS && defined(USE_THREAD_ALLOC)
    if (!quick) {
	/*
	 * Quick exit principle makes it useless to terminate allocators
	 */
	TclFinalizeThreadAllocThread();
    }
#endif
................................................................................

void
TclFinalizeSynchronization(void)
{
    int i;
    void *blockPtr;
    Tcl_ThreadDataKey *keyPtr;
#if TCL_THREADS
    Tcl_Mutex *mutexPtr;
    Tcl_Condition *condPtr;

    TclpMasterLock();
#endif

    /*
................................................................................
	}
	ckfree(keyRecord.list);
	keyRecord.list = NULL;
    }
    keyRecord.max = 0;
    keyRecord.num = 0;

#if TCL_THREADS
    /*
     * Call thread storage master cleanup.
     */

    TclFinalizeThreadStorage();

    for (i=0 ; i<mutexRecord.num ; i++) {
................................................................................
 */

void
Tcl_ExitThread(
    int status)
{
    Tcl_FinalizeThread();

    TclpThreadExit(status);

}

#if !TCL_THREADS
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_ConditionWait, et al. --
 *
 *	These noop functions are provided so the stub table does not have to

Changes to generic/tclThreadAlloc.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if (!defined(TCL_THREADS) || TCL_THREADS) && defined(USE_THREAD_ALLOC)

/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */

#ifndef RCHECK







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * Portions created by AOL are Copyright (C) 1999 America Online, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if TCL_THREADS && defined(USE_THREAD_ALLOC)

/*
 * If range checking is enabled, an additional byte will be allocated to store
 * the magic number at the end of the requested memory.
 */

#ifndef RCHECK

Changes to generic/tclThreadStorage.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if !defined(TCL_THREADS) || TCL_THREADS
#include <signal.h>

/*
 * IMPLEMENTATION NOTES:
 *
 * The primary idea is that we create one platform-specific TSD slot, and use
 * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into







|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if TCL_THREADS
#include <signal.h>

/*
 * IMPLEMENTATION NOTES:
 *
 * The primary idea is that we create one platform-specific TSD slot, and use
 * it for storing a table pointer. Each Tcl_ThreadDataKey has an offset into

Changes to generic/tclThreadTest.c.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

#if !defined(TCL_THREADS) || TCL_THREADS
/*
 * Each thread has an single instance of the following structure. There is one
 * instance of this structure per thread even if that thread contains multiple
 * interpreters. The interpreter identified by this structure is the main
 * interpreter for the thread.
 *
 * The main interpreter is the one that will process any messages received by







|







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 */

#ifndef USE_TCL_STUBS
#   define USE_TCL_STUBS
#endif
#include "tclInt.h"

#if TCL_THREADS
/*
 * Each thread has an single instance of the following structure. There is one
 * instance of this structure per thread even if that thread contains multiple
 * interpreters. The interpreter identified by this structure is the main
 * interpreter for the thread.
 *
 * The main interpreter is the one that will process any messages received by

Changes to macosx/GNUmakefile.

128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
	${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/"

${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
		     ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in
	mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \
	if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
	--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
	--mandir="${MANDIR}" --enable-threads --enable-framework --enable-dtrace \
	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi

build-${PROJECT}: ${objdir}/Makefile
	${DO_MAKE}
ifeq (${INSTALL_BUILD},)
# symolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'







|







128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
	${MAKE} install-${PROJECT} INSTALL_ROOT="${OBJ_DIR}/"

${objdir}/Makefile: ${UNIX_DIR}/Makefile.in ${UNIX_DIR}/configure \
		     ${UNIX_DIR}/tclConfig.sh.in Tcl-Info.plist.in
	mkdir -p "${OBJ_DIR}" && cd "${OBJ_DIR}" && \
	if [ ${UNIX_DIR}/configure -nt config.status ]; then ${UNIX_DIR}/configure -C \
	--prefix="${PREFIX}" --bindir="${BINDIR}" --libdir="${LIBDIR}" \
	--mandir="${MANDIR}" --enable-framework --enable-dtrace \
	${CONFIGURE_ARGS} ${EXTRA_CONFIGURE_ARGS}; else ./config.status; fi

build-${PROJECT}: ${objdir}/Makefile
	${DO_MAKE}
ifeq (${INSTALL_BUILD},)
# symolic link hackery to trick
# 'make install INSTALL_ROOT=${OBJ_DIR}'

Changes to macosx/Tcl-Common.xcconfig.

26
27
28
29
30
31
32
33
34
35
36
37
FRAMEWORK_INSTALL_PATH = /Library/Frameworks
INCLUDEDIR = $(PREFIX)/include
LIBDIR = $(PREFIX)/lib
MANDIR = $(PREFIX)/man
PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
PREFIX = /usr/local
TCL_CONFIGURE_ARGS = --enable-threads --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
VERSION = 8.7







|




26
27
28
29
30
31
32
33
34
35
36
37
FRAMEWORK_INSTALL_PATH = /Library/Frameworks
INCLUDEDIR = $(PREFIX)/include
LIBDIR = $(PREFIX)/lib
MANDIR = $(PREFIX)/man
PER_ARCH_CFLAGS_ppc = -mcpu=G3 -mtune=G4 $(PER_ARCH_CFLAGS_ppc)
PER_ARCH_CFLAGS_ppc64 = -mcpu=G5 -mpowerpc64 $(PER_ARCH_CFLAGS_ppc64)
PREFIX = /usr/local
TCL_CONFIGURE_ARGS = --enable-dtrace
TCL_LIBRARY = $(LIBDIR)/tcl$(VERSION)
TCL_PACKAGE_PATH = "$(LIBDIR)"
TCL_DEFS = HAVE_TCL_CONFIG_H
VERSION = 8.7

Changes to tests/async.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
...
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
...
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
...
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint threaded [::tcl::pkgconfig get threaded]

proc async1 {result code} {
    global aresult acode
    set aresult $result
    set acode $code
    return "new result"
}
................................................................................

test async-3.1 {deleting handlers} testasync {
    set x {}
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

test async-4.1 {async interrupting bytecode sequence} -constraints {
    testasync threaded
} -setup {
    set hm [testasync create async3]
    proc nothing {} {
	# empty proc
    }
} -body {
    apply {{handle} {
................................................................................
	}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
    testasync threaded
} -setup {
    set hm [testasync create async3]
} -body {
    apply {{handle} {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
................................................................................
	} {incr i} {}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
    testasync threaded
} -setup {
    set hm [testasync create async3]
} -body {
    apply [list {handle} [concat {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle







<







 







|







 







|







 







|







16
17
18
19
20
21
22

23
24
25
26
27
28
29
...
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
...
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
...
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]


proc async1 {result code} {
    global aresult acode
    set aresult $result
    set acode $code
    return "new result"
}
................................................................................

test async-3.1 {deleting handlers} testasync {
    set x {}
    list [catch {testasync mark $hm2 "foobar" 5} msg] $msg $x
} {3 del2 {0 0 0 del1 del2}}

test async-4.1 {async interrupting bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
    proc nothing {} {
	# empty proc
    }
} -body {
    apply {{handle} {
................................................................................
	}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    testasync delete $hm
}
test async-4.2 {async interrupting straight bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
    apply {{handle} {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle
................................................................................
	} {incr i} {}
	return $aresult
    }} $hm
} -result {test pattern} -cleanup {
    testasync delete $hm
}
test async-4.3 {async interrupting loop-less bytecode sequence} -constraints {
    testasync
} -setup {
    set hm [testasync create async3]
} -body {
    apply [list {handle} [concat {
	global aresult
	set aresult {Async event not delivered}
	testasync marklater $handle

Changes to tests/fileSystem.test.

260
261
262
263
264
265
266






267
268
269
270
271
272
273
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} -body {
    file normalize ~noonewiththisname
} -returnCodes error -result {user "noonewiththisname" doesn't exist}






test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar







>
>
>
>
>
>







260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
file delete -force [file join dir.dir dirinside.link]
removeFile [file join dir.dir inside.file]
removeDirectory [file join dir.dir dirinside.dir]
removeDirectory dir.dir
test filesystem-1.30 {normalisation of nonexistent user} -body {
    file normalize ~noonewiththisname
} -returnCodes error -result {user "noonewiththisname" doesn't exist}
test filesystem-1.30.1 {normalisation of existing user} -body {
    catch {file normalize ~$::tcl_platform(user)}
} -result {0}
test filesystem-1.30.2 {normalisation of nonexistent user specified as user@domain} -body {
    file normalize ~nonexistentuser@nonexistentdomain
} -returnCodes error -result {user "nonexistentuser@nonexistentdomain" doesn't exist}
test filesystem-1.31 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /foo/../bar
} {/bar}
test filesystem-1.32 {link normalisation: link near filesystem root} {testsetplatform} {
    testsetplatform unix
    file normalize /../bar

Changes to tests/process.test.

267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-7.3 {child killed} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) -1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

::tcltest::cleanupTests
return







|










267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) 1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child process exited abnormally} {CHILDSTATUS * 1}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}
test process-7.3 {child killed} -constraints {win} -body {
    tcl::process autopurge 0
    set pid [exec [interpreter] $path(exit) -1 &]
    lindex [tcl::process status -wait $pid] 1
} -match glob -result {1 {child killed: unknown signal} {CHILDKILLED * {unknown signal} {unknown signal}}} -cleanup {
    tcl::process purge
    tcl::process autopurge 1
}

::tcltest::cleanupTests
return

Changes to tests/unixNotfy.test.

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
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# When run in a Tk shell, these tests hang.
testConstraint noTk [expr {0 != [catch {package present Tk}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]
# Darwin always uses a threaded notifier
testConstraint unthreaded [expr {
    ![::tcl::pkgconfig get threaded]
    && $tcl_platform(os) ne "Darwin"
}]

# The next two tests will hang if threads are enabled because the notifier
# will not necessarily wait for ever in this case, so it does not generate
# an error.
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints {noTk unix unthreaded} -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1







<
<
<
<
<




|










|







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
    package require tcltest 2
    namespace import -force ::tcltest::*
}

# When run in a Tk shell, these tests hang.
testConstraint noTk [expr {0 != [catch {package present Tk}]}]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]






# The next two tests will hang if threads are enabled because the notifier
# will not necessarily wait for ever in this case, so it does not generate
# an error.
test unixNotfy-1.1 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
    catch {vwait x}
    set f [open [makeFile "" foo] w]
    fileevent $f writable {set x 1}
    vwait x
    close $f
    list [catch {vwait x} msg] $msg
} -result {1 {can't wait for variable "x": would wait forever}} -cleanup {
    catch { close $f }
    catch { removeFile foo }
}
test unixNotfy-1.2 {Tcl_DeleteFileHandler} -constraints nonPortable -body {
    catch {vwait x}
    set f1 [open [makeFile "" foo] w]
    set f2 [open [makeFile "" foo2] w]
    fileevent $f1 writable {set x 1}
    fileevent $f2 writable {set y 1}
    vwait x
    close $f1

Changes to tests/winFCmd.test.

1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
    file delete -force -- c:/td1
} -result {c:/td1}
test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup {
    catch {file delete -force -- $::env(TEMP)/td1}
} -constraints {win} -body {
    createfile $::env(TEMP)/td1 {}
    string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \
	    [string tolower [file normalize $::env(TEMP)]/td1]]
} -cleanup {
    file delete -force -- $::env(TEMP)/td1
} -result 1
test winFCmd-12.7 {ConvertFileNameFormat} -body {
    string tolower [file attributes //bisque/tcl/ws -longname]
} -constraints {nonPortable win} -result {//bisque/tcl/ws}
test winFCmd-12.8 {ConvertFileNameFormat} -setup {







|







1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
    file delete -force -- c:/td1
} -result {c:/td1}
test winFCmd-12.6.2 {ConvertFileNameFormat: absolute path with drive (in temp folder)} -setup {
    catch {file delete -force -- $::env(TEMP)/td1}
} -constraints {win} -body {
    createfile $::env(TEMP)/td1 {}
    string equal [string tolower [file attributes $::env(TEMP)/td1 -longname]] \
	    [string tolower [file normalize $::env(TEMP)]/td1]
} -cleanup {
    file delete -force -- $::env(TEMP)/td1
} -result 1
test winFCmd-12.7 {ConvertFileNameFormat} -body {
    string tolower [file attributes //bisque/tcl/ws -longname]
} -constraints {nonPortable win} -result {//bisque/tcl/ws}
test winFCmd-12.8 {ConvertFileNameFormat} -setup {

Changes to unix/Makefile.in.

1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
	      echo "Configuring package '$$pkg'"; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
		( cd $(PKG_DIR)/$$pkg; \
		  $$i/configure --with-tcl=../.. \
		      --with-tclinclude=$(GENERIC_DIR) \
		      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
		      --enable-shared --enable-threads; ) || exit $$?; \
	      fi; \
	    fi; \
	  fi; \
	done

packages: configure-packages ${STUB_LIB_FILE}
	@for i in $(PKGS_DIR)/*; do \







|







1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
	      echo "Configuring package '$$pkg'"; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
		( cd $(PKG_DIR)/$$pkg; \
		  $$i/configure --with-tcl=../.. \
		      --with-tclinclude=$(GENERIC_DIR) \
		      $(PKG_CFG_ARGS) --libdir=$(PACKAGE_DIR) \
		      --enable-shared; ) || exit $$?; \
	      fi; \
	    fi; \
	  fi; \
	done

packages: configure-packages ${STUB_LIB_FILE}
	@for i in $(PKGS_DIR)/*; do \

Changes to unix/README.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
(c) Type "./configure". This runs a configuration script created by GNU
    autoconf, which configures Tcl for your system and creates a Makefile. The
    configure script allows you to customize the Tcl configuration for your
    site; for details on how you can do this, type "./configure --help" or
    refer to the autoconf documentation (not included here). Tcl's "configure"
    supports the following special switches in addition to the standard ones:

	--enable-threads	If this switch is set, Tcl will compile itself
				with multithreading support.
	--disable-load		If this switch is specified then Tcl will
				configure itself not to allow dynamic loading,
				even if your system appears to support it.
				Normally you can leave this switch out and Tcl
				will build itself for dynamic loading if your
				system supports it.
	--disable-dll-unloading	Disables support for the [unload] command even







<
<







41
42
43
44
45
46
47


48
49
50
51
52
53
54
(c) Type "./configure". This runs a configuration script created by GNU
    autoconf, which configures Tcl for your system and creates a Makefile. The
    configure script allows you to customize the Tcl configuration for your
    site; for details on how you can do this, type "./configure --help" or
    refer to the autoconf documentation (not included here). Tcl's "configure"
    supports the following special switches in addition to the standard ones:



	--disable-load		If this switch is specified then Tcl will
				configure itself not to allow dynamic loading,
				even if your system appears to support it.
				Normally you can leave this switch out and Tcl
				will build itself for dynamic loading if your
				system supports it.
	--disable-dll-unloading	Disables support for the [unload] command even

Changes to unix/configure.

4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
....
5174
5175
5176
5177
5178
5179
5180
5181
5182
5183
5184
5185
5186
5187
5188
5189
5190
....
5623
5624
5625
5626
5627
5628
5629
5630
5631
5632
5633
5634
5635
5636
5637
5638
5639
5640
5641
5642
5643
5644
....
5648
5649
5650
5651
5652
5653
5654
5655
5656
5657
5658
5659
5660
5661
5662
5663
5664
5665
5666
5667
5668
5669
....
5671
5672
5673
5674
5675
5676
5677
5678
5679
5680
5681
5682
5683
5684
5685
5686
5687
5688
5689
5690
5691
....
6039
6040
6041
6042
6043
6044
6045
6046
6047
6048
6049
6050
6051
6052
6053
6054
6055
6056
6057
6058
6059
6060
6061
6062
6063
6064
6065
6066
6067
....
7312
7313
7314
7315
7316
7317
7318
7319
7320
7321
7322
7323
7324
7325
7326
....
7435
7436
7437
7438
7439
7440
7441
7442
7443
7444
7445
7446
7447
7448
7449
7450
....
7532
7533
7534
7535
7536
7537
7538
7539
7540
7541
7542
7543
7544
7545
7546
....
7628
7629
7630
7631
7632
7633
7634
7635
7636
7637
7638
7639
7640
7641
7642
....
7724
7725
7726
7727
7728
7729
7730
7731
7732
7733
7734
7735
7736
7737
7738
....
7820
7821
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
7841
7842
7843
7844
7845
7846
7847
7848
7849
7850
7851
7852
7853
7854
7855
7856
7857
7858
7859
....
7982
7983
7984
7985
7986
7987
7988
7989
7990
7991
7992
7993
7994
7995
7996
....
8084
8085
8086
8087
8088
8089
8090
8091
8092
8093
8094
8095
8096
8097
8098
....
8276
8277
8278
8279
8280
8281
8282
8283
8284
8285
8286
8287
8288
8289
8290
8291
8292
8293
    PLAT_SRCS=""
    LDAIX_SRC=""
    if test "x${SHLIB_VERSION}" = x; then :
  SHLIB_VERSION="1.0"
fi
    case $system in
	AIX-*)
	    if test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"; then :

		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
................................................................................

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
$as_echo "$ac_cv_cygwin" >&6; }
	    if test "$ac_cv_cygwin" = "no"; then
		as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		as_fn_error $? "CYGWIN compile is only supported with --enable-threads" "$LINENO" 5
	    fi
	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
................................................................................

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"
	    if test "${TCL_THREADS}" = "1"; then :

		# On OpenBSD:	Compile with -pthread
		#		Don't link with -lpthread
		LIBS=`echo $LIBS | sed s/-lpthread//`
		CFLAGS="$CFLAGS -pthread"

fi
	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
................................................................................
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    if test "${TCL_THREADS}" = "1"; then :

		# The -pthread needs to go in the CFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS -pthread"
	    	LDFLAGS="$LDFLAGS -pthread"

fi
	    ;;
	FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@"
	    SHLIB_SUFFIX=".so"
................................................................................
	    DL_LIBS=""
	    LDFLAGS=""
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    if test "${TCL_THREADS}" = "1"; then :

		# The -pthread needs to go in the LDFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
fi
	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
................................................................................
	    if test "$GCC" = yes; then :
  CFLAGS="$CFLAGS -mieee"
else

		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"
fi
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa
	    if test "${TCL_THREADS}" = 1; then :

		CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
		CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
		LIBS=`echo $LIBS | sed s/-lpthreads//`
		if test "$GCC" = yes; then :

		    LIBS="$LIBS -lpthread -lmach -lexc"

else

		    CFLAGS="$CFLAGS -pthread"
		    LDFLAGS="$LDFLAGS -pthread"

fi

fi
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
................................................................................
else

$as_echo "#define NO_UNAME 1" >>confdefs.h

fi


if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
	test "`uname -r | awk -F. '{print $1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath"
if test "x$ac_cv_func_realpath" = xyes; then :
................................................................................
fi


#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------

if test "${TCL_THREADS}" = 1; then
    ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r"
if test "x$ac_cv_func_getpwuid_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5
$as_echo_n "checking for getpwuid_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwuid_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETPWUID_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r"
if test "x$ac_cv_func_getpwnam_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5
$as_echo_n "checking for getpwnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwnam_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETPWNAM_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r"
if test "x$ac_cv_func_getgrgid_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5
$as_echo_n "checking for getgrgid_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrgid_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETGRGID_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r"
if test "x$ac_cv_func_getgrnam_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5
$as_echo_n "checking for getgrnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrnam_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETGRNAM_R 1" >>confdefs.h

    fi

fi

    if test "`uname -s`" = "Darwin" && \
	    test "`uname -r | awk -F. '{print $1}'`" -gt 5; then
	# Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
	# are actually MT-safe as they always return pointers
	# from TSD instead of static storage.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


    elif test "`uname -s`" = "HP-UX" && \
	      test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
        # Starting with HPUX 11.00 (we believe), gethostbyX
        # are actually MT-safe as they always return pointers
	# from TSD instead of static storage.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


    else
	ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r"
if test "x$ac_cv_func_gethostbyname_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5
$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; }
if ${tcl_cv_api_gethostbyname_r_6+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h

    fi

fi

	ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r"
if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5
$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; }
if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h

    fi

fi

    fi
fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
................................................................................
fi;;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: OSX" >&5
$as_echo "OSX" >&6; };;
  *)
	cat >>confdefs.h <<_ACEOF
#define NOTIFIER_SELECT 1
_ACEOF

	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&6; };;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------







|







 







<
<
<







 







<
<
|
|
|
|
<
<







 







<
<
|
|
|
|
<
<







 







<
<
|
|
|
|
<







 







<
<
|
|
|
|

|



|
|
<
<







 







|







 







<
|







 







|







 







|







 







|







 







|
|
|
|
|







|
|
|
|
|







|
|







 







|







 







<







 







<
<
<
<







4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
....
5174
5175
5176
5177
5178
5179
5180



5181
5182
5183
5184
5185
5186
5187
....
5620
5621
5622
5623
5624
5625
5626


5627
5628
5629
5630


5631
5632
5633
5634
5635
5636
5637
....
5641
5642
5643
5644
5645
5646
5647


5648
5649
5650
5651


5652
5653
5654
5655
5656
5657
5658
....
5660
5661
5662
5663
5664
5665
5666


5667
5668
5669
5670

5671
5672
5673
5674
5675
5676
5677
....
6025
6026
6027
6028
6029
6030
6031


6032
6033
6034
6035
6036
6037
6038
6039
6040
6041
6042


6043
6044
6045
6046
6047
6048
6049
....
7294
7295
7296
7297
7298
7299
7300
7301
7302
7303
7304
7305
7306
7307
7308
....
7417
7418
7419
7420
7421
7422
7423

7424
7425
7426
7427
7428
7429
7430
7431
....
7513
7514
7515
7516
7517
7518
7519
7520
7521
7522
7523
7524
7525
7526
7527
....
7609
7610
7611
7612
7613
7614
7615
7616
7617
7618
7619
7620
7621
7622
7623
....
7705
7706
7707
7708
7709
7710
7711
7712
7713
7714
7715
7716
7717
7718
7719
....
7801
7802
7803
7804
7805
7806
7807
7808
7809
7810
7811
7812
7813
7814
7815
7816
7817
7818
7819
7820
7821
7822
7823
7824
7825
7826
7827
7828
7829
7830
7831
7832
7833
7834
7835
7836
7837
7838
7839
7840
....
7963
7964
7965
7966
7967
7968
7969
7970
7971
7972
7973
7974
7975
7976
7977
....
8065
8066
8067
8068
8069
8070
8071

8072
8073
8074
8075
8076
8077
8078
....
8256
8257
8258
8259
8260
8261
8262




8263
8264
8265
8266
8267
8268
8269
    PLAT_SRCS=""
    LDAIX_SRC=""
    if test "x${SHLIB_VERSION}" = x; then :
  SHLIB_VERSION="1.0"
fi
    case $system in
	AIX-*)
	    if test "$GCC" != "yes"; then :

		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
................................................................................

fi
{ $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_cygwin" >&5
$as_echo "$ac_cv_cygwin" >&6; }
	    if test "$ac_cv_cygwin" = "no"; then
		as_fn_error $? "${CC} is not a cygwin compiler." "$LINENO" 5
	    fi



	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
................................................................................

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"


	    # On OpenBSD:	Compile with -pthread
	    #		Don't link with -lpthread
	    LIBS=`echo $LIBS | sed s/-lpthread//`
	    CFLAGS="$CFLAGS -pthread"


	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
................................................................................
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}


	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"


	    ;;
	FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$@"
	    SHLIB_SUFFIX=".so"
................................................................................
	    DL_LIBS=""
	    LDFLAGS=""
	    if test $doRpath = yes; then :

		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
fi


	    # The -pthread needs to go in the LDFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
	    LDFLAGS="$LDFLAGS $PTHREAD_LIBS"

	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
................................................................................
	    if test "$GCC" = yes; then :
  CFLAGS="$CFLAGS -mieee"
else

		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"
fi
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa


	    CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
	    CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
	    LIBS=`echo $LIBS | sed s/-lpthreads//`
	    if test "$GCC" = yes; then :

		LIBS="$LIBS -lpthread -lmach -lexc"

else

		CFLAGS="$CFLAGS -pthread"
		LDFLAGS="$LDFLAGS -pthread"



fi
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
................................................................................
else

$as_echo "#define NO_UNAME 1" >>confdefs.h

fi


if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print $1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
ac_fn_c_check_func "$LINENO" "realpath" "ac_cv_func_realpath"
if test "x$ac_cv_func_realpath" = xyes; then :
................................................................................
fi


#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------


ac_fn_c_check_func "$LINENO" "getpwuid_r" "ac_cv_func_getpwuid_r"
if test "x$ac_cv_func_getpwuid_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwuid_r with 5 args" >&5
$as_echo_n "checking for getpwuid_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwuid_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETPWUID_R 1" >>confdefs.h

    fi

fi

ac_fn_c_check_func "$LINENO" "getpwnam_r" "ac_cv_func_getpwnam_r"
if test "x$ac_cv_func_getpwnam_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getpwnam_r with 5 args" >&5
$as_echo_n "checking for getpwnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getpwnam_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETPWNAM_R 1" >>confdefs.h

    fi

fi

ac_fn_c_check_func "$LINENO" "getgrgid_r" "ac_cv_func_getgrgid_r"
if test "x$ac_cv_func_getgrgid_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrgid_r with 5 args" >&5
$as_echo_n "checking for getgrgid_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrgid_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETGRGID_R 1" >>confdefs.h

    fi

fi

ac_fn_c_check_func "$LINENO" "getgrnam_r" "ac_cv_func_getgrnam_r"
if test "x$ac_cv_func_getgrnam_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getgrnam_r with 5 args" >&5
$as_echo_n "checking for getgrnam_r with 5 args... " >&6; }
if ${tcl_cv_api_getgrnam_r_5+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETGRNAM_R 1" >>confdefs.h

    fi

fi

if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print $1}'`" -gt 5; then
    # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


elif test "`uname -s`" = "HP-UX" && \
	test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
    # Starting with HPUX 11.00 (we believe), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.

$as_echo "#define HAVE_MTSAFE_GETHOSTBYNAME 1" >>confdefs.h


$as_echo "#define HAVE_MTSAFE_GETHOSTBYADDR 1" >>confdefs.h


else
    ac_fn_c_check_func "$LINENO" "gethostbyname_r" "ac_cv_func_gethostbyname_r"
if test "x$ac_cv_func_gethostbyname_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyname_r with 6 args" >&5
$as_echo_n "checking for gethostbyname_r with 6 args... " >&6; }
if ${tcl_cv_api_gethostbyname_r_6+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETHOSTBYNAME_R 1" >>confdefs.h

    fi

fi

    ac_fn_c_check_func "$LINENO" "gethostbyaddr_r" "ac_cv_func_gethostbyaddr_r"
if test "x$ac_cv_func_gethostbyaddr_r" = xyes; then :

    { $as_echo "$as_me:${as_lineno-$LINENO}: checking for gethostbyaddr_r with 7 args" >&5
$as_echo_n "checking for gethostbyaddr_r with 7 args... " >&6; }
if ${tcl_cv_api_gethostbyaddr_r_7+:} false; then :
  $as_echo_n "(cached) " >&6
else
................................................................................

$as_echo "#define HAVE_GETHOSTBYADDR_R 1" >>confdefs.h

    fi

fi


fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
................................................................................
fi;;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: OSX" >&5
$as_echo "OSX" >&6; };;
  *)




	{ $as_echo "$as_me:${as_lineno-$LINENO}: result: none" >&5
$as_echo "none" >&6; };;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------

Changes to unix/configure.ac.

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
...
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331

AC_REPLACE_FUNCS(mkstemp opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

if test "`uname -s`" = "Darwin" && test "${TCL_THREADS}" = 1 && \
	test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])])

SC_TCL_IPV6

#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------

if test "${TCL_THREADS}" = 1; then
    SC_TCL_GETPWUID_R
    SC_TCL_GETPWNAM_R
    SC_TCL_GETGRGID_R
    SC_TCL_GETGRNAM_R
    if test "`uname -s`" = "Darwin" && \
	    test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
	# Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
	# are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
		[Do we have MT-safe gethostbyname() ?])
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
		[Do we have MT-safe gethostbyaddr() ?])

    elif test "`uname -s`" = "HP-UX" && \
	      test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
        # Starting with HPUX 11.00 (we believe), gethostbyX
        # are actually MT-safe as they always return pointers
	# from TSD instead of static storage.
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
		[Do we have MT-safe gethostbyname() ?])
	AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
		[Do we have MT-safe gethostbyaddr() ?])

    else
	SC_TCL_GETHOSTBYNAME_R
	SC_TCL_GETHOSTBYADDR_R
    fi
fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
................................................................................
	AS_IF([test $tcl_kqueue_headers = xyyy], [
	    AC_DEFINE(NOTIFIER_KQUEUE, [1], [Is kqueue(2) supported?])]);;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	AC_MSG_RESULT([OSX]);;
  *)
	AC_DEFINE_UNQUOTED(NOTIFIER_SELECT)
	AC_MSG_RESULT([none]);;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------








|













<
|
|
|
|
|
|
|
|
|
|
|
|
|

|
|
|
|
|
|
|
|
|

|
|
|
<







 







<







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
...
315
316
317
318
319
320
321

322
323
324
325
326
327
328

AC_REPLACE_FUNCS(mkstemp opendir strtol waitpid)
AC_CHECK_FUNC(strerror, , [AC_DEFINE(NO_STRERROR, 1, [Do we have strerror()])])
AC_CHECK_FUNC(getwd, , [AC_DEFINE(NO_GETWD, 1, [Do we have getwd()])])
AC_CHECK_FUNC(wait3, , [AC_DEFINE(NO_WAIT3, 1, [Do we have wait3()])])
AC_CHECK_FUNC(uname, , [AC_DEFINE(NO_UNAME, 1, [Do we have uname()])])

if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print [$]1}'`" -lt 7; then
    # prior to Darwin 7, realpath is not threadsafe, so don't
    # use it when threads are enabled, c.f. bug # 711232
    ac_cv_func_realpath=no
fi
AC_CHECK_FUNC(realpath, , [AC_DEFINE(NO_REALPATH, 1, [Do we have realpath()])])

SC_TCL_IPV6

#--------------------------------------------------------------------
#	Look for thread-safe variants of some library functions.
#--------------------------------------------------------------------


SC_TCL_GETPWUID_R
SC_TCL_GETPWNAM_R
SC_TCL_GETGRGID_R
SC_TCL_GETGRNAM_R
if test "`uname -s`" = "Darwin" && \
	test "`uname -r | awk -F. '{print [$]1}'`" -gt 5; then
    # Starting with Darwin 6 (Mac OSX 10.2), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
	    [Do we have MT-safe gethostbyname() ?])
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
	    [Do we have MT-safe gethostbyaddr() ?])

elif test "`uname -s`" = "HP-UX" && \
	test "`uname -r|sed -e 's|B\.||' -e 's|\..*$||'`" -gt 10; then
    # Starting with HPUX 11.00 (we believe), gethostbyX
    # are actually MT-safe as they always return pointers
    # from TSD instead of static storage.
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYNAME, 1,
	    [Do we have MT-safe gethostbyname() ?])
    AC_DEFINE(HAVE_MTSAFE_GETHOSTBYADDR, 1,
	    [Do we have MT-safe gethostbyaddr() ?])

else
    SC_TCL_GETHOSTBYNAME_R
    SC_TCL_GETHOSTBYADDR_R

fi

#---------------------------------------------------------------------------
#	Check for serial port interface.
#
#	termios.h is present on all POSIX systems.
#	sys/ioctl.h is almost always present, though what it contains
................................................................................
	AS_IF([test $tcl_kqueue_headers = xyyy], [
	    AC_DEFINE(NOTIFIER_KQUEUE, [1], [Is kqueue(2) supported?])]);;
  xDarwin)
	# Assume that we've got CoreFoundation present (checked elsewhere because
	# of wider impact).
	AC_MSG_RESULT([OSX]);;
  *)

	AC_MSG_RESULT([none]);;
esac

#------------------------------------------------------------------------------
#       Find out all about time handling differences.
#------------------------------------------------------------------------------

Changes to unix/tcl.m4.

990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
....
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
....
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
....
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
....
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
....
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
    PLAT_OBJS=""
    PLAT_SRCS=""
    LDAIX_SRC=""
    AS_IF([test "x${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
    case $system in
	AIX-*)
	    AS_IF([test "${TCL_THREADS}" = "1" -a "$GCC" != "yes"], [
		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
			# Make sure only first arg gets _r
................................................................................
		], [],
		ac_cv_cygwin=no,
		ac_cv_cygwin=yes)
	    )
	    if test "$ac_cv_cygwin" = "no"; then
		AC_MSG_ERROR([${CC} is not a cygwin compiler.])
	    fi
	    if test "x${TCL_THREADS}" = "x0"; then
		AC_MSG_ERROR([CYGWIN compile is only supported with --enable-threads])
	    fi
	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
................................................................................
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# On OpenBSD:	Compile with -pthread
		#		Don't link with -lpthread
		LIBS=`echo $LIBS | sed s/-lpthread//`
		CFLAGS="$CFLAGS -pthread"
	    ])
	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
................................................................................
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# The -pthread needs to go in the CFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS -pthread"
	    	LDFLAGS="$LDFLAGS -pthread"
	    ])
	    ;;
	FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    AS_IF([test "${TCL_THREADS}" = "1"], [
		# The -pthread needs to go in the LDFLAGS, not LIBS
		LIBS=`echo $LIBS | sed s/-pthread//`
		CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
		LDFLAGS="$LDFLAGS $PTHREAD_LIBS"])
	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
................................................................................
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
	    AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [
		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"])
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa
	    AS_IF([test "${TCL_THREADS}" = 1], [
		CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
		CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
		LIBS=`echo $LIBS | sed s/-lpthreads//`
		AS_IF([test "$GCC" = yes], [
		    LIBS="$LIBS -lpthread -lmach -lexc"
		], [
		    CFLAGS="$CFLAGS -pthread"
		    LDFLAGS="$LDFLAGS -pthread"
		])
	    ])
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="ld -Bshareable -x"
................................................................................
#
# Results:
#
#	Sets the following vars:
#		THREADS_LIBS	Thread library(s)
#
#	Defines the following vars:
#		TCL_THREADS
#		_REENTRANT
#		_THREAD_SAFE
#
#	Might append to the following vars:
#		LIBS
#		MATH_LIBS
#







|







 







<
<
<







 







<
|
|
|
|
<







 







<
|
|
|
|
<













<
|
|
|
|







 







<
|
|
|
|
|
|
|
|
<







 







<







990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
....
1111
1112
1113
1114
1115
1116
1117



1118
1119
1120
1121
1122
1123
1124
....
1340
1341
1342
1343
1344
1345
1346

1347
1348
1349
1350

1351
1352
1353
1354
1355
1356
1357
....
1359
1360
1361
1362
1363
1364
1365

1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382

1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
....
1551
1552
1553
1554
1555
1556
1557

1558
1559
1560
1561
1562
1563
1564
1565

1566
1567
1568
1569
1570
1571
1572
....
2240
2241
2242
2243
2244
2245
2246

2247
2248
2249
2250
2251
2252
2253
    LD_LIBRARY_PATH_VAR="LD_LIBRARY_PATH"
    PLAT_OBJS=""
    PLAT_SRCS=""
    LDAIX_SRC=""
    AS_IF([test "x${SHLIB_VERSION}" = x], [SHLIB_VERSION="1.0"])
    case $system in
	AIX-*)
	    AS_IF([test "$GCC" != "yes"], [
		# AIX requires the _r compiler when gcc isn't being used
		case "${CC}" in
		    *_r|*_r\ *)
			# ok ...
			;;
		    *)
			# Make sure only first arg gets _r
................................................................................
		], [],
		ac_cv_cygwin=no,
		ac_cv_cygwin=yes)
	    )
	    if test "$ac_cv_cygwin" = "no"; then
		AC_MSG_ERROR([${CC} is not a cygwin compiler.])
	    fi



	    do64bit_ok=yes
	    if test "x${SHARED_BUILD}" = "x1"; then
		echo "running cd ../win; ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args"
		# The eval makes quoting arguments work.
		if cd ../win; eval ${CONFIG_SHELL-/bin/sh} ./configure $ac_configure_args; cd ../unix
		then :
		else
................................................................................
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}
	    SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so.${SHLIB_VERSION}'
	    LDFLAGS="-Wl,-export-dynamic"
	    CFLAGS_OPTIMIZE="-O2"

	    # On OpenBSD:	Compile with -pthread
	    #		Don't link with -lpthread
	    LIBS=`echo $LIBS | sed s/-lpthread//`
	    CFLAGS="$CFLAGS -pthread"

	    # OpenBSD doesn't do version numbers with dots.
	    UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
	    TCL_LIB_VERSIONS_OK=nodots
	    ;;
	NetBSD-*)
	    # NetBSD has ELF and can use 'cc -shared' to build shared libs
	    SHLIB_CFLAGS="-fPIC"
................................................................................
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])
	    LD_SEARCH_FLAGS=${CC_SEARCH_FLAGS}

	    # The -pthread needs to go in the CFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS -pthread"
	    LDFLAGS="$LDFLAGS -pthread"

	    ;;
	FreeBSD-*)
	    # This configuration from FreeBSD Ports.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="${CC} -shared"
	    SHLIB_LD_LIBS="${SHLIB_LD_LIBS} -Wl,-soname,\$[@]"
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS=""
	    LDFLAGS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'])

	    # The -pthread needs to go in the LDFLAGS, not LIBS
	    LIBS=`echo $LIBS | sed s/-pthread//`
	    CFLAGS="$CFLAGS $PTHREAD_CFLAGS"
	    LDFLAGS="$LDFLAGS $PTHREAD_LIBS"
	    case $system in
	    FreeBSD-3.*)
		# Version numbers are dot-stripped by system policy.
		TCL_TRIM_DOTS=`echo ${VERSION} | tr -d .`
		UNSHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.a'
		SHARED_LIB_SUFFIX='${TCL_TRIM_DOTS}.so'
		TCL_LIB_VERSIONS_OK=nodots
................................................................................
	    DL_LIBS=""
	    AS_IF([test $doRpath = yes], [
		CC_SEARCH_FLAGS='-Wl,-rpath,${LIB_RUNTIME_DIR}'
		LD_SEARCH_FLAGS='-rpath ${LIB_RUNTIME_DIR}'])
	    AS_IF([test "$GCC" = yes], [CFLAGS="$CFLAGS -mieee"], [
		CFLAGS="$CFLAGS -DHAVE_TZSET -std1 -ieee"])
	    # see pthread_intro(3) for pthread support on osf1, k.furukawa

	    CFLAGS="$CFLAGS -DHAVE_PTHREAD_ATTR_SETSTACKSIZE"
	    CFLAGS="$CFLAGS -DTCL_THREAD_STACK_MIN=PTHREAD_STACK_MIN*64"
	    LIBS=`echo $LIBS | sed s/-lpthreads//`
	    AS_IF([test "$GCC" = yes], [
		LIBS="$LIBS -lpthread -lmach -lexc"
	    ], [
		CFLAGS="$CFLAGS -pthread"
		LDFLAGS="$LDFLAGS -pthread"

	    ])
	    ;;
	QNX-6*)
	    # QNX RTP
	    # This may work for all QNX, but it was only reported for v6.
	    SHLIB_CFLAGS="-fPIC"
	    SHLIB_LD="ld -Bshareable -x"
................................................................................
#
# Results:
#
#	Sets the following vars:
#		THREADS_LIBS	Thread library(s)
#
#	Defines the following vars:

#		_REENTRANT
#		_THREAD_SAFE
#
#	Might append to the following vars:
#		LIBS
#		MATH_LIBS
#

Changes to unix/tclConfig.h.in.

381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

/* Is memory debugging enabled? */
#undef TCL_MEM_DEBUG

/* What is the default extension for shared libraries? */
#undef TCL_SHLIB_EXT

/* Are we building with threads enabled? */
#undef TCL_THREADS

/* Do we allow unloading of shared libraries? */
#undef TCL_UNLOAD_DLLS

/* Does this platform have wide high-resolution clicks? */
#undef TCL_WIDE_CLICKS

/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */







<
<
<







381
382
383
384
385
386
387



388
389
390
391
392
393
394

/* Is memory debugging enabled? */
#undef TCL_MEM_DEBUG

/* What is the default extension for shared libraries? */
#undef TCL_SHLIB_EXT




/* Do we allow unloading of shared libraries? */
#undef TCL_UNLOAD_DLLS

/* Does this platform have wide high-resolution clicks? */
#undef TCL_WIDE_CLICKS

/* Do Tcl_WideInt, 'long' and 'long long' all have the same size (64-bit) ? */

Changes to unix/tclConfig.sh.in.

160
161
162
163
164
165
166
167
168
169
TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'

# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=@TCL_THREADS@







<
<
<
160
161
162
163
164
165
166



TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'



Changes to unix/tclEpollNotfy.c.

8
9
10
11
12
13
14

15
16
17
18
19
20
21
22
23
24
25
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */


#ifdef NOTIFIER_EPOLL

#define _GNU_SOURCE		/* For pipe2(2) */
#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <fcntl.h>
#include <signal.h>
#include <sys/epoll.h>
#ifdef HAVE_EVENTFD
#include <sys/eventfd.h>







>
|


<







8
9
10
11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(NOTIFIER_EPOLL) && TCL_THREADS

#define _GNU_SOURCE		/* For pipe2(2) */

#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <fcntl.h>
#include <signal.h>
#include <sys/epoll.h>
#ifdef HAVE_EVENTFD
#include <sys/eventfd.h>

Changes to unix/tclKqueueNotfy.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#ifdef NOTIFIER_KQUEUE

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>
#include <sys/types.h>
#include <sys/event.h>
#include <sys/queue.h>
#include <sys/time.h>







|
|
|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(NOTIFIER_KQUEUE) && TCL_THREADS

#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>
#include <sys/types.h>
#include <sys/event.h>
#include <sys/queue.h>
#include <sys/time.h>

Changes to unix/tclSelectNotfy.c.

7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
..
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
...
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
...
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
...
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
...
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */


#if !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)

#include "tclInt.h"
#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
................................................................................
				 * to Tcl_CreateFileHandler. */
    SelectMasks readyMasks;	/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks (one
				 * more than highest fd for which
				 * Tcl_WatchFile has been called). */
#if !defined(TCL_THREADS) || TCL_THREADS
    int onList;			/* True if it is in this list */
    unsigned int pollState;	/* pollState is used to implement a polling
				 * handshake between each thread and the
				 * notifier thread. Bits defined below. */
    struct ThreadSpecificData *nextPtr, *prevPtr;
				/* All threads that are currently waiting on
				 * an event have their ThreadSpecificData
................................................................................
				 * Used as condition flag together with waitCV
				 * above. */
#endif /* TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#if !defined(TCL_THREADS) || TCL_THREADS
/*
 * The following static indicates the number of threads that have initialized
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

................................................................................
static Tcl_ThreadId notifierThread;
#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#if !defined(TCL_THREADS) || TCL_THREADS
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int	atForkInit = 0;
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
................................................................................
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if !defined(TCL_THREADS) || TCL_THREADS
	tsdPtr->eventReady = 0;

	/*
	 * Initialize thread specific condition variable for this thread.
	 */
	if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
................................................................................
Tcl_FinalizeNotifier(
    ClientData clientData)		/* Not used. */
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
#if !defined(TCL_THREADS) || TCL_THREADS
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	pthread_mutex_lock(&notifierInitMutex);
	notifierCount--;

	/*
	 * If this is the last thread to use the notifier, close the notifier
................................................................................
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
#if !defined(TCL_THREADS) || TCL_THREADS
	int waitForFiles;
#   ifdef __CYGWIN__
	MSG msg;
#   endif /* __CYGWIN__ */
#else
	/*
	 * Impl. notes: timeout & timeoutPtr are used if, and only if threads
................................................................................
	     */

	    if (timePtr->sec != 0 || timePtr->usec != 0) {
		vTime = *timePtr;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		timePtr = &vTime;
	    }
#if defined(TCL_THREADS) && !TCL_THREADS
	    timeout.tv_sec = timePtr->sec;
	    timeout.tv_usec = timePtr->usec;
	    timeoutPtr = &timeout;
	} else if (tsdPtr->numFdBits == 0) {
	    /*
	     * If there are no threads, no timeout, and no fds registered,
	     * then there are no events possible and we must avoid deadlock.
................................................................................

	    return -1;
	} else {
	    timeoutPtr = NULL;
#endif /* !TCL_THREADS */
	}

#if !defined(TCL_THREADS) || TCL_THREADS
	/*
	 * Start notifier thread and place this thread on the list of
	 * interested threads, signal the notifier thread, and wait for a
	 * response or a timeout.
	 */
	StartNotifierThread("Tcl_WaitForEvent");

................................................................................

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
#if !defined(TCL_THREADS) || TCL_THREADS
	pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
	return 0;
    }
}
 
#if !defined(TCL_THREADS) || TCL_THREADS
 
/*
 *----------------------------------------------------------------------
 *
 * NotifierThreadProc --
 *
 *	This routine is the initial (and only) function executed by the







>
|

<







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|







 







|






|







7
8
9
10
11
12
13
14
15
16

17
18
19
20
21
22
23
..
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
...
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
...
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
...
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
...
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
...
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
...
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
...
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
...
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
 *
 * Copyright (c) 1995-1997 Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if (!defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)) || !TCL_THREADS


#ifndef HAVE_COREFOUNDATION	/* Darwin/Mac OS X CoreFoundation notifier is
				 * in tclMacOSXNotify.c */
#include <signal.h>

/*
 * This structure is used to keep track of the notifier info for a registered
 * file.
................................................................................
				 * to Tcl_CreateFileHandler. */
    SelectMasks readyMasks;	/* This array reflects the readable/writable
				 * conditions that were found to exist by the
				 * last call to select. */
    int numFdBits;		/* Number of valid bits in checkMasks (one
				 * more than highest fd for which
				 * Tcl_WatchFile has been called). */
#if TCL_THREADS
    int onList;			/* True if it is in this list */
    unsigned int pollState;	/* pollState is used to implement a polling
				 * handshake between each thread and the
				 * notifier thread. Bits defined below. */
    struct ThreadSpecificData *nextPtr, *prevPtr;
				/* All threads that are currently waiting on
				 * an event have their ThreadSpecificData
................................................................................
				 * Used as condition flag together with waitCV
				 * above. */
#endif /* TCL_THREADS */
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;

#if TCL_THREADS
/*
 * The following static indicates the number of threads that have initialized
 * notifiers.
 *
 * You must hold the notifierMutex lock before accessing this variable.
 */

................................................................................
static Tcl_ThreadId notifierThread;
#endif /* TCL_THREADS */

/*
 * Static routines defined in this file.
 */

#if TCL_THREADS
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static int	atForkInit = 0;
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
................................................................................
Tcl_InitNotifier(void)
{
    if (tclNotifierHooks.initNotifierProc) {
	return tclNotifierHooks.initNotifierProc();
    } else {
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if TCL_THREADS
	tsdPtr->eventReady = 0;

	/*
	 * Initialize thread specific condition variable for this thread.
	 */
	if (tsdPtr->waitCVinitialized == 0) {
#ifdef __CYGWIN__
................................................................................
Tcl_FinalizeNotifier(
    ClientData clientData)		/* Not used. */
{
    if (tclNotifierHooks.finalizeNotifierProc) {
	tclNotifierHooks.finalizeNotifierProc(clientData);
	return;
    } else {
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

	pthread_mutex_lock(&notifierInitMutex);
	notifierCount--;

	/*
	 * If this is the last thread to use the notifier, close the notifier
................................................................................
{
    if (tclNotifierHooks.waitForEventProc) {
	return tclNotifierHooks.waitForEventProc(timePtr);
    } else {
	FileHandler *filePtr;
	int mask;
	Tcl_Time vTime;
#if TCL_THREADS
	int waitForFiles;
#   ifdef __CYGWIN__
	MSG msg;
#   endif /* __CYGWIN__ */
#else
	/*
	 * Impl. notes: timeout & timeoutPtr are used if, and only if threads
................................................................................
	     */

	    if (timePtr->sec != 0 || timePtr->usec != 0) {
		vTime = *timePtr;
		tclScaleTimeProcPtr(&vTime, tclTimeClientData);
		timePtr = &vTime;
	    }
#if !TCL_THREADS
	    timeout.tv_sec = timePtr->sec;
	    timeout.tv_usec = timePtr->usec;
	    timeoutPtr = &timeout;
	} else if (tsdPtr->numFdBits == 0) {
	    /*
	     * If there are no threads, no timeout, and no fds registered,
	     * then there are no events possible and we must avoid deadlock.
................................................................................

	    return -1;
	} else {
	    timeoutPtr = NULL;
#endif /* !TCL_THREADS */
	}

#if TCL_THREADS
	/*
	 * Start notifier thread and place this thread on the list of
	 * interested threads, signal the notifier thread, and wait for a
	 * response or a timeout.
	 */
	StartNotifierThread("Tcl_WaitForEvent");

................................................................................

		fileEvPtr->header.proc = FileHandlerEventProc;
		fileEvPtr->fd = filePtr->fd;
		Tcl_QueueEvent((Tcl_Event *) fileEvPtr, TCL_QUEUE_TAIL);
	    }
	    filePtr->readyMask = mask;
	}
#if TCL_THREADS
	pthread_mutex_unlock(&notifierMutex);
#endif /* TCL_THREADS */
	return 0;
    }
}
 
#if TCL_THREADS
 
/*
 *----------------------------------------------------------------------
 *
 * NotifierThreadProc --
 *
 *	This routine is the initial (and only) function executed by the

Changes to unix/tclUnixCompat.c.

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
...
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
...
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
    }

/*
 * Per-thread private storage used to store values returned from MT-unsafe
 * library calls.
 */

#if !defined(TCL_THREADS) || TCL_THREADS

typedef struct {
    struct passwd pwd;
#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
#define NEED_PW_CLEANER 1
    char *pbuf;
    int pbuflen;
................................................................................
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwNam(
    const char *name)
{
#if defined(TCL_THREADS) && !TCL_THREADS
    return getpwnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWNAM_R_5)
    struct passwd *pwPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwUid(
    uid_t uid)
{
#if defined(TCL_THREADS) && !TCL_THREADS
    return getpwuid(uid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWUID_R_5)
    struct passwd *pwPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrNam(
    const char *name)
{
#if defined(TCL_THREADS) && !TCL_THREADS
    return getgrnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRNAM_R_5)
    struct group *grPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrGid(
    gid_t gid)
{
#if defined(TCL_THREADS) && !TCL_THREADS
    return getgrgid(gid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRGID_R_5)
    struct group *grPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByName(
    const char *name)
{
#if (defined(TCL_THREADS) && !TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYNAME)
    return gethostbyname(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYNAME_R_5)
    int h_errno;

................................................................................

struct hostent *
TclpGetHostByAddr(
    const char *addr,
    int length,
    int type)
{
#if (defined(TCL_THREADS) && !TCL_THREADS) || defined(HAVE_MTSAFE_GETHOSTBYADDR)
    return gethostbyaddr(addr, length, type);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYADDR_R_7)
    int h_errno;








|







 







|







 







|







 







|







 







|







 







|







 







|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
...
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
...
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
...
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
...
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
...
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
...
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
    }

/*
 * Per-thread private storage used to store values returned from MT-unsafe
 * library calls.
 */

#if TCL_THREADS

typedef struct {
    struct passwd pwd;
#if defined(HAVE_GETPWNAM_R_5) || defined(HAVE_GETPWUID_R_5)
#define NEED_PW_CLEANER 1
    char *pbuf;
    int pbuflen;
................................................................................
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwNam(
    const char *name)
{
#if !TCL_THREADS
    return getpwnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWNAM_R_5)
    struct passwd *pwPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct passwd *
TclpGetPwUid(
    uid_t uid)
{
#if !TCL_THREADS
    return getpwuid(uid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETPWUID_R_5)
    struct passwd *pwPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrNam(
    const char *name)
{
#if !TCL_THREADS
    return getgrnam(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRNAM_R_5)
    struct group *grPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct group *
TclpGetGrGid(
    gid_t gid)
{
#if !TCL_THREADS
    return getgrgid(gid);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETGRGID_R_5)
    struct group *grPtr = NULL;

................................................................................
 *---------------------------------------------------------------------------
 */

struct hostent *
TclpGetHostByName(
    const char *name)
{
#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYNAME)
    return gethostbyname(name);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYNAME_R_5)
    int h_errno;

................................................................................

struct hostent *
TclpGetHostByAddr(
    const char *addr,
    int length,
    int type)
{
#if !TCL_THREADS || defined(HAVE_MTSAFE_GETHOSTBYADDR)
    return gethostbyaddr(addr, length, type);
#else
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);

#if defined(HAVE_GETHOSTBYADDR_R_7)
    int h_errno;

Changes to unix/tclUnixFCmd.c.

252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    return realpath(path, resolved);
}
#else
#   define Realpath	realpath
#endif /* PURIFY */

#ifndef NO_REALPATH
#if defined(__APPLE__) && (!defined(TCL_THREADS) || TCL_THREADS) && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/*
 * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we
 * might potentially be running on pre-10.3 OSX, check Darwin release at
 * runtime before using realpath.
 */







|







252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
    return realpath(path, resolved);
}
#else
#   define Realpath	realpath
#endif /* PURIFY */

#ifndef NO_REALPATH
#if defined(__APPLE__) && TCL_THREADS && \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && \
	MAC_OS_X_VERSION_MIN_REQUIRED < 1030
/*
 * Prior to Darwin 7, realpath is not thread-safe, c.f. Bug 711232; if we
 * might potentially be running on pre-10.3 OSX, check Darwin release at
 * runtime before using realpath.
 */

Changes to unix/tclUnixInit.c.

312
313
314
315
316
317
318
319
320
321
322
323
324
325
326

#ifdef HAVE_COREFOUNDATION
static int		MacOSXGetLibraryPath(Tcl_Interp *interp,
			    int maxPathLen, char *tclLibPath);
#endif /* HAVE_COREFOUNDATION */
#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \
	((!defined(TCL_THREADS) || TCL_THREADS) && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
	(defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \
	(defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\
	)))
/*
 * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
 * initialize release global at startup from uname().
 */







|







312
313
314
315
316
317
318
319
320
321
322
323
324
325
326

#ifdef HAVE_COREFOUNDATION
static int		MacOSXGetLibraryPath(Tcl_Interp *interp,
			    int maxPathLen, char *tclLibPath);
#endif /* HAVE_COREFOUNDATION */
#if defined(__APPLE__) && (defined(TCL_LOAD_FROM_MEMORY) || ( \
	defined(MAC_OS_X_VERSION_MIN_REQUIRED) && ( \
	(TCL_THREADS && MAC_OS_X_VERSION_MIN_REQUIRED < 1030) || \
	(defined(__LP64__) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050) || \
	(defined(HAVE_COREFOUNDATION) && MAC_OS_X_VERSION_MIN_REQUIRED < 1050)\
	)))
/*
 * Need to check Darwin release at runtime in tclUnixFCmd.c and tclLoadDyld.c:
 * initialize release global at startup from uname().
 */

Changes to unix/tclUnixNotfy.c.

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
..
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <poll.h>


/*
 * Static routines defined in this file.
 */





#ifdef NOTIFIER_SELECT
#if !defined(TCL_THREADS) || TCL_THREADS


static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
#if defined(HAVE_PTHREAD_ATFORK)
static void	AtForkChild(void);
#endif /* HAVE_PTHREAD_ATFORK */
#endif /* TCL_THREADS */
#endif /* NOTIFIER_SELECT */
static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
 
#ifdef NOTIFIER_SELECT
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * StartNotifierThread --
 *
 *	Start a notfier thread and wait for the notifier pipe to be created.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Running Thread.
 *
................................................................................
	    pthread_mutex_unlock(&notifierMutex);

	    notifierThreadRunning = 1;
	}
	pthread_mutex_unlock(&notifierInitMutex);
    }
}
#endif /* TCL_THREADS */
#endif /* NOTIFIER_SELECT */
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
................................................................................
    ClientData clientData)
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#if !defined(TCL_THREADS) || TCL_THREADS
	ThreadSpecificData *tsdPtr = clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
................................................................................
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else if (mode == TCL_SERVICE_ALL) {
#ifdef NOTIFIER_SELECT
#if !defined(TCL_THREADS) || TCL_THREADS
	StartNotifierThread("Tcl_ServiceModeHook");
#endif
#endif /* NOTIFIER_SELECT */
    }
}
 
/*
................................................................................
	}
	break;
    }
    return 1;
}
 
#ifdef NOTIFIER_SELECT
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * AlertSingleThread --
 *
 *	Notify a single thread that is waiting on a file descriptor to become
 *	readable or writable or to have an exception condition.







>





>
>
>
>
|
<
>
>

|

|
<
<
<

<
<





|







 







<







 







|







 







|







 







|







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
..
67
68
69
70
71
72
73

74
75
76
77
78
79
80
...
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
...
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
...
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
 * Copyright (c) 2016 Lucio Andrés Illanes Albornoz <l.illanes@gmx.de>
 *
 * See the file "license.terms" for information on usage and redistribution
 * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include <poll.h>
#include "tclInt.h"

/*
 * Static routines defined in this file.
 */

static int	FileHandlerEventProc(Tcl_Event *evPtr, int flags);
#if !TCL_THREADS
# undef NOTIFIER_EPOLL
# undef NOTIFIER_KQUEUE
# define NOTIFIER_SELECT

#elif !defined(NOTIFIER_EPOLL) && !defined(NOTIFIER_KQUEUE)
# define NOTIFIER_SELECT
static TCL_NORETURN void NotifierThreadProc(ClientData clientData);
# if defined(HAVE_PTHREAD_ATFORK)
static void	AtForkChild(void);
# endif /* HAVE_PTHREAD_ATFORK */



 


/*
 *----------------------------------------------------------------------
 *
 * StartNotifierThread --
 *
 *	Start a notifier thread and wait for the notifier pipe to be created.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Running Thread.
 *
................................................................................
	    pthread_mutex_unlock(&notifierMutex);

	    notifierThreadRunning = 1;
	}
	pthread_mutex_unlock(&notifierInitMutex);
    }
}

#endif /* NOTIFIER_SELECT */
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_AlertNotifier --
 *
................................................................................
    ClientData clientData)
{
    if (tclNotifierHooks.alertNotifierProc) {
	tclNotifierHooks.alertNotifierProc(clientData);
	return;
    } else {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	ThreadSpecificData *tsdPtr = clientData;

	pthread_mutex_lock(&notifierMutex);
	tsdPtr->eventReady = 1;

#   ifdef __CYGWIN__
	PostMessageW(tsdPtr->hwnd, 1024, 0, 0);
................................................................................
				 * TCL_SERVICE_NONE. */
{
    if (tclNotifierHooks.serviceModeHookProc) {
	tclNotifierHooks.serviceModeHookProc(mode);
	return;
    } else if (mode == TCL_SERVICE_ALL) {
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
	StartNotifierThread("Tcl_ServiceModeHook");
#endif
#endif /* NOTIFIER_SELECT */
    }
}
 
/*
................................................................................
	}
	break;
    }
    return 1;
}
 
#ifdef NOTIFIER_SELECT
#if TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * AlertSingleThread --
 *
 *	Notify a single thread that is waiting on a file descriptor to become
 *	readable or writable or to have an exception condition.

Changes to unix/tclUnixThrd.c.

9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
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
...
183
184
185
186
187
188
189

190
191


192

193
194
195
196
197
198
199
...
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
...
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
...
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
...
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
...
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
...
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
...
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
...
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if !defined(TCL_THREADS) || TCL_THREADS

#ifndef TCL_NO_DEPRECATED
typedef struct {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
................................................................................
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if !defined(TCL_THREADS) || TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

................................................................................
int
Tcl_JoinThread(
    Tcl_ThreadId threadId,	/* Id of the thread to wait upon. */
    int *state)			/* Reference to the storage the result of the
				 * thread we wait upon will be written into.
				 * May be NULL. */
{
#if !defined(TCL_THREADS) || TCL_THREADS
    int result;
    unsigned long retcode, *retcodePtr = &retcode;

    result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
    if (state) {
	*state = (int) retcode;
    }
    return (result == 0) ? TCL_OK : TCL_ERROR;
#else
    return TCL_ERROR;
#endif
}
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
 *	This procedure terminates the current thread.
 *
................................................................................
 *----------------------------------------------------------------------
 */

void
TclpThreadExit(
    int status)
{

    pthread_exit(INT2PTR(status));
}


#endif /* TCL_THREADS */

 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCurrentThread --
 *
 *	This procedure returns the ID of the currently running thread.
................................................................................
 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    return (Tcl_ThreadId) pthread_self();
#else
    return (Tcl_ThreadId) 0;
#endif
}
 
/*
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    pthread_mutex_lock(&initLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    /*
     * You do not need to destroy mutexes that were created with the
     * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
     * destruction: masterLock, allocLock, and initLock.
     */

    pthread_mutex_unlock(&initLock);
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpInitUnlock(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    pthread_mutex_unlock(&initLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterLock(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}

 
/*
 *----------------------------------------------------------------------
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterUnlock(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    pthread_mutex_unlock(&masterLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;
    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#if !defined(TCL_THREADS) || TCL_THREADS
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This procedure handles
................................................................................
}

#undef TclpInetNtoa
char *
TclpInetNtoa(
    struct in_addr addr)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    unsigned char *b = (unsigned char*) &addr.s_addr;

    sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]);
    return tsdPtr->nabuf;
#else
    return inet_ntoa(addr);
#endif
}
#endif /* TCL_NO_DEPRECATED */
 
#if !defined(TCL_THREADS) || TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;








|







 







|







 







|













<







 







>

<
>
>

>







 







|







 







|







 







|







 







|







 







|







 







|







 







|







|







 







|











|







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
..
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
...
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
...
182
183
184
185
186
187
188
189
190

191
192
193
194
195
196
197
198
199
200
201
...
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
...
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
...
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
...
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
...
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
...
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
...
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
...
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#if TCL_THREADS

#ifndef TCL_NO_DEPRECATED
typedef struct {
    char nabuf[16];
} ThreadSpecificData;

static Tcl_ThreadDataKey dataKey;
................................................................................
    Tcl_ThreadId *idPtr,	/* Return, the ID of the thread */
    Tcl_ThreadCreateProc *proc,	/* Main() function of the thread */
    ClientData clientData,	/* The one argument to Main() */
    int stackSize,		/* Size of stack for the new thread */
    int flags)			/* Flags controlling behaviour of the new
				 * thread. */
{
#if TCL_THREADS
    pthread_attr_t attr;
    pthread_t theThread;
    int result;

    pthread_attr_init(&attr);
    pthread_attr_setscope(&attr, PTHREAD_SCOPE_SYSTEM);

................................................................................
int
Tcl_JoinThread(
    Tcl_ThreadId threadId,	/* Id of the thread to wait upon. */
    int *state)			/* Reference to the storage the result of the
				 * thread we wait upon will be written into.
				 * May be NULL. */
{
#if TCL_THREADS
    int result;
    unsigned long retcode, *retcodePtr = &retcode;

    result = pthread_join((pthread_t) threadId, (void**) retcodePtr);
    if (state) {
	*state = (int) retcode;
    }
    return (result == 0) ? TCL_OK : TCL_ERROR;
#else
    return TCL_ERROR;
#endif
}
 

/*
 *----------------------------------------------------------------------
 *
 * TclpThreadExit --
 *
 *	This procedure terminates the current thread.
 *
................................................................................
 *----------------------------------------------------------------------
 */

void
TclpThreadExit(
    int status)
{
#if TCL_THREADS
    pthread_exit(INT2PTR(status));

#else /* TCL_THREADS */
    exit(status);
#endif /* TCL_THREADS */
}
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetCurrentThread --
 *
 *	This procedure returns the ID of the currently running thread.
................................................................................
 *
 *----------------------------------------------------------------------
 */

Tcl_ThreadId
Tcl_GetCurrentThread(void)
{
#if TCL_THREADS
    return (Tcl_ThreadId) pthread_self();
#else
    return (Tcl_ThreadId) 0;
#endif
}
 
/*
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpInitLock(void)
{
#if TCL_THREADS
    pthread_mutex_lock(&initLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclFinalizeLock(void)
{
#if TCL_THREADS
    /*
     * You do not need to destroy mutexes that were created with the
     * PTHREAD_MUTEX_INITIALIZER macro. These mutexes do not need any
     * destruction: masterLock, allocLock, and initLock.
     */

    pthread_mutex_unlock(&initLock);
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpInitUnlock(void)
{
#if TCL_THREADS
    pthread_mutex_unlock(&initLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterLock(void)
{
#if TCL_THREADS
    pthread_mutex_lock(&masterLock);
#endif
}

 
/*
 *----------------------------------------------------------------------
................................................................................
 *
 *----------------------------------------------------------------------
 */

void
TclpMasterUnlock(void)
{
#if TCL_THREADS
    pthread_mutex_unlock(&masterLock);
#endif
}
 
/*
 *----------------------------------------------------------------------
 *
................................................................................
 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
    pthread_mutex_t **allocLockPtrPtr = &allocLockPtr;
    return (Tcl_Mutex *) allocLockPtrPtr;
#else
    return NULL;
#endif
}

#if TCL_THREADS
 
/*
 *----------------------------------------------------------------------
 *
 * Tcl_MutexLock --
 *
 *	This procedure is invoked to lock a mutex. This procedure handles
................................................................................
}

#undef TclpInetNtoa
char *
TclpInetNtoa(
    struct in_addr addr)
{
#if TCL_THREADS
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    unsigned char *b = (unsigned char*) &addr.s_addr;

    sprintf(tsdPtr->nabuf, "%u.%u.%u.%u", b[0], b[1], b[2], b[3]);
    return tsdPtr->nabuf;
#else
    return inet_ntoa(addr);
#endif
}
#endif /* TCL_NO_DEPRECATED */
 
#if TCL_THREADS
/*
 * Additions by AOL for specialized thread memory allocator.
 */

#ifdef USE_THREAD_ALLOC
static pthread_key_t key;

Changes to win/Makefile.in.

770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
	  if [ -d $$i ] ; then \
	    if [ -x $$i/configure ] ; then \
	      pkg=`basename $$i`; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        ( cd $(PKG_DIR)/$$pkg; \
	          echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
	          $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared --enable-threads; ) \
	      fi ; \
	      echo "Building package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir







|







770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
	  if [ -d $$i ] ; then \
	    if [ -x $$i/configure ] ; then \
	      pkg=`basename $$i`; \
	      mkdir -p $(PKG_DIR)/$$pkg; \
	      if [ ! -f $(PKG_DIR)/$$pkg/Makefile ]; then \
	        ( cd $(PKG_DIR)/$$pkg; \
	          echo "Configuring package '$$i' wd = `$(CYGPATH) $$(pwd -P)`"; \
	          $$i/configure --with-tcl=$$builddir --with-tclinclude=$(GENERIC_DIR_NATIVE) $(PKG_CFG_ARGS) --enable-shared; ) \
	      fi ; \
	      echo "Building package '$$pkg'"; \
	      ( cd $(PKG_DIR)/$$pkg; $(MAKE); ) \
	    fi; \
	  fi; \
	done; \
	cd $$builddir

Changes to win/makefile.vc.

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
...
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
...
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
# Tcl itself. This is used when building extensions.
#---------------------------------------------------------------------
tcl-nmake: $(OUT_DIR)\tcl.nmake
$(OUT_DIR)\tcl.nmake:
	@type << >$@
CORE_MACHINE = $(MACHINE)
CORE_DEBUG = $(DEBUG)
CORE_TCL_THREADS = $(TCL_THREADS)
CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
CORE_USE_WIDECHAR_API = $(USE_WIDECHAR_API)
<<

#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------
................................................................................
@TCL_INCLUDE_SPEC@   -I$(INCLUDE_INSTALL_DIR)
@TCL_LIB_VERSIONS_OK@
@TCL_SRC_DIR@        $(ROOT)
@TCL_PACKAGE_PATH@
@TCL_STUB_LIB_FILE@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_FLAG@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_SPEC@  -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)
@TCL_THREADS@        $(TCL_THREADS)
@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
@TCL_STUB_LIB_PATH@  $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
@CFG_TCL_EXPORT_FILE_SUFFIX@  $(VERSION)$(SUFX).lib
@CFG_TCL_SHARED_LIB_SUFFIX@   $(VERSION)$(SUFX).dll
@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
!if $(STATIC_BUILD)
................................................................................

$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
	$(cc32) $(appcflags) \
	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

### The following objects should be built using the stub interfaces
### *ALL* extensions need to built with -DTCL_THREADS=1

$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
!if $(STATIC_BUILD)
	$(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $?
!else
	$(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $?
!endif







<







 







<







 







<







578
579
580
581
582
583
584

585
586
587
588
589
590
591
...
633
634
635
636
637
638
639

640
641
642
643
644
645
646
...
705
706
707
708
709
710
711

712
713
714
715
716
717
718
# Tcl itself. This is used when building extensions.
#---------------------------------------------------------------------
tcl-nmake: $(OUT_DIR)\tcl.nmake
$(OUT_DIR)\tcl.nmake:
	@type << >$@
CORE_MACHINE = $(MACHINE)
CORE_DEBUG = $(DEBUG)

CORE_USE_THREAD_ALLOC = $(USE_THREAD_ALLOC)
CORE_USE_WIDECHAR_API = $(USE_WIDECHAR_API)
<<

#---------------------------------------------------------------------
# Build tclConfig.sh for the TEA build system.
#---------------------------------------------------------------------
................................................................................
@TCL_INCLUDE_SPEC@   -I$(INCLUDE_INSTALL_DIR)
@TCL_LIB_VERSIONS_OK@
@TCL_SRC_DIR@        $(ROOT)
@TCL_PACKAGE_PATH@
@TCL_STUB_LIB_FILE@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_FLAG@  $(TCLSTUBLIBNAME)
@TCL_STUB_LIB_SPEC@  -L$(LIB_INSTALL_DIR) $(TCLSTUBLIBNAME)

@TCL_BUILD_STUB_LIB_SPEC@ -L$(OUT_DIR) $(TCLSTUBLIBNAME)
@TCL_BUILD_STUB_LIB_PATH@ $(TCLSTUBLIB)
@TCL_STUB_LIB_PATH@  $(LIB_INSTALL_DIR)\$(TCLSTUBLIBNAME)
@CFG_TCL_EXPORT_FILE_SUFFIX@  $(VERSION)$(SUFX).lib
@CFG_TCL_SHARED_LIB_SUFFIX@   $(VERSION)$(SUFX).dll
@CFG_TCL_UNSHARED_LIB_SUFFIX@ $(VERSION)$(SUFX).lib
!if $(STATIC_BUILD)
................................................................................

$(TMP_DIR)\tclAppInit.obj: $(WINDIR)\tclAppInit.c
	$(cc32) $(appcflags) \
	    -DTCL_USE_STATIC_PACKAGES=$(TCL_USE_STATIC_PACKAGES) \
	    -Fo$@ $?

### The following objects should be built using the stub interfaces


$(TMP_DIR)\tclWinReg.obj: $(WINDIR)\tclWinReg.c
!if $(STATIC_BUILD)
	$(cc32) $(appcflags) -DSTATIC_BUILD -Fo$@ $?
!else
	$(cc32) $(appcflags) -DUSE_TCL_STUBS -Fo$@ $?
!endif

Changes to win/rules.vc.

20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
RULES_VERSION_MINOR = 2

# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif

!if "$(PRJ_PACKAGE_TCLNAME)" == ""
................................................................................
!else # ! $(DOING_TCL)

!if $(TCLINSTALL) # Building against an installed Tcl

# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
# Try various possibilities in turn.
TCLSH		= $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX).exe
!if !exist("$(TCLSH)")
TCLSH           = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!endif

TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"

!else # Building against Tcl sources

TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX).exe
!if !exist($(TCLSH))
TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!endif
TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"








|







 







|

|



|



|









|

|


|



|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
....
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
!ifndef _RULES_VC
_RULES_VC = 1

# The following macros define the version of the rules.vc nmake build system
# For modifications that are not backward-compatible, you *must* change
# the major version.
RULES_VERSION_MAJOR = 1
RULES_VERSION_MINOR = 3

# The PROJECT macro must be defined by parent makefile.
!if "$(PROJECT)" == ""
!error *** Error: Macro PROJECT not defined! Please define it before including rules.vc
!endif

!if "$(PRJ_PACKAGE_TCLNAME)" == ""
................................................................................
!else # ! $(DOING_TCL)

!if $(TCLINSTALL) # Building against an installed Tcl

# When building extensions, we need to locate tclsh. Depending on version
# of Tcl we are building against, this may or may not have a "t" suffix.
# Try various possibilities in turn.
TCLSH		= $(_TCLDIR)\bin\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist("$(TCLSH)")
TCLSH           = $(_TCLDIR)\bin\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif

TCLSTUBLIB	= $(_TCLDIR)\lib\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\lib\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\lib
TCLREGLIB	= $(_TCLDIR)\lib\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\lib\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= \must\have\tcl\sources\to\build\this\target
TCL_INCLUDES    = -I"$(_TCLDIR)\include"

!else # Building against Tcl sources

TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)$(SUFX:t=).exe
!if !exist($(TCLSH))
TCLSH		= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclsh$(TCL_VERSION)t$(SUFX:t=).exe
!endif
TCLSTUBLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclstub$(TCL_VERSION).lib
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)$(SUFX:t=).lib
# When building extensions, may be linking against Tcl that does not add
# "t" suffix (e.g. 8.5 or 8.7). If lib not found check for that possibility.
!if !exist("$(TCLIMPLIB)")
TCLIMPLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcl$(TCL_VERSION)t$(SUFX:t=).lib
!endif
TCL_LIBRARY	= $(_TCLDIR)\library
TCLREGLIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tclreg13$(SUFX:t=).lib
TCLDDELIB	= $(_TCLDIR)\win\$(BUILDDIRTOP)\tcldde14$(SUFX:t=).lib
TCLTOOLSDIR	= $(_TCLDIR)\tools
TCL_INCLUDES	= -I"$(_TCLDIR)\generic" -I"$(_TCLDIR)\win"

Changes to win/tclConfig.sh.in.

171
172
173
174
175
176
177
178
179
180
181
TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'

# Flag, 1: we built Tcl with threads enabled, 0 we didn't
TCL_THREADS=@TCL_THREADS@








<
<
<
<
171
172
173
174
175
176
177




TCL_STUB_LIB_SPEC='@TCL_STUB_LIB_SPEC@'

# Path to the Tcl stub library in the build directory.
TCL_BUILD_STUB_LIB_PATH='@TCL_BUILD_STUB_LIB_PATH@'

# Path to the Tcl stub library in the install directory.
TCL_STUB_LIB_PATH='@TCL_STUB_LIB_PATH@'




Changes to win/tclWinFile.c.

863
864
865
866
867
868
869

870
871
872
873
874
875
876
....
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448

1449
1450
1451
















1452
1453
1454
1455
1456
1457
1458
1459
1460
1461













1462
1463

1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480




1481
1482
1483
1484
1485
1486
1487

    /*
     * Under Windows we ignore argv0, and return the path for the file used to
     * create this process. Only if it is NULL, install a new panic handler.
     */

    if (argv0 == NULL) {

	Tcl_SetPanicProc(tclWinDebugPanic);
    }

#ifdef UNICODE
    GetModuleFileNameW(NULL, wName, MAX_PATH);
#else
    GetModuleFileNameA(NULL, name, sizeof(name));
................................................................................

const char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    const char *result = NULL;
    USER_INFO_1 *uiPtr, **uiPtrPtr = &uiPtr;
    Tcl_DString ds;
    int nameLen = -1;
    int badDomain = 0;
    char *domain;
    WCHAR *wName, *wHomeDir, *wDomain, **wDomainPtr = &wDomain;
    WCHAR buf[MAX_PATH];

    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = strchr(name, '@');
    if (domain != NULL) {
















	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
	badDomain = NetGetDCName(NULL, wName, (LPBYTE *) wDomainPtr);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (badDomain == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	if (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) uiPtrPtr) == 0) {













	    wHomeDir = uiPtr->usri1_home_dir;
	    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {

		Tcl_UniCharToUtfDString(wHomeDir, lstrlenW(wHomeDir),
			bufferPtr);
	    } else {
		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */
		DWORD i, size = MAX_PATH;
		GetProfilesDirectoryW(buf, &size);
		for (i = 0; i < size; ++i){
		    if (buf[i] == '\\') buf[i] = '/';
		}
		Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
		Tcl_DStringAppend(bufferPtr, "/", -1);
		Tcl_DStringAppend(bufferPtr, name, -1);
	    }
	    result = Tcl_DStringValue(bufferPtr);




	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
	NetApiBufferFree((void *) wDomain);
    }







>







 







|
|


|
|
|



>

|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


|



|


|
>
>
>
>
>
>
>
>
>
>
>
>
>


>
|
<





<

<
<
<

|
|


>
>
>
>







863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
....
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496

1497
1498
1499
1500
1501

1502



1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518

    /*
     * Under Windows we ignore argv0, and return the path for the file used to
     * create this process. Only if it is NULL, install a new panic handler.
     */

    if (argv0 == NULL) {
#	undef Tcl_SetPanicProc
	Tcl_SetPanicProc(tclWinDebugPanic);
    }

#ifdef UNICODE
    GetModuleFileNameW(NULL, wName, MAX_PATH);
#else
    GetModuleFileNameA(NULL, name, sizeof(name));
................................................................................

const char *
TclpGetUserHome(
    const char *name,		/* User name for desired home directory. */
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * name of user's home directory. */
{
    char *result = NULL;
    USER_INFO_1 *uiPtr;
    Tcl_DString ds;
    int nameLen = -1;
    int rc = 0;
    const char *domain;
    WCHAR *wName, *wHomeDir, *wDomain;
    WCHAR buf[MAX_PATH];

    Tcl_DStringInit(bufferPtr);

    wDomain = NULL;
    domain = Tcl_UtfFindFirst(name, '@');
    if (domain == NULL) {
	const char *ptr;
	
	/* no domain - firstly check it's the current user */
	if ( (ptr = TclpGetUserName(&ds)) != NULL 
	  && strcasecmp(name, ptr) == 0
	) {
	    /* try safest and fastest way to get current user home */
	    ptr = TclGetEnv("HOME", &ds);
	    if (ptr != NULL) {
		Tcl_JoinPath(1, &ptr, bufferPtr);
		rc = 1;
		result = Tcl_DStringValue(bufferPtr);
	    }
	}
	Tcl_DStringFree(&ds);
    } else {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(domain + 1, -1, &ds);
	rc = NetGetDCName(NULL, wName, (LPBYTE *) &wDomain);
	Tcl_DStringFree(&ds);
	nameLen = domain - name;
    }
    if (rc == 0) {
	Tcl_DStringInit(&ds);
	wName = Tcl_UtfToUniCharDString(name, nameLen, &ds);
	while (NetUserGetInfo(wDomain, wName, 1, (LPBYTE *) &uiPtr) != 0) {
	    /* 
	     * user does not exists - if domain was not specified,
	     * try again using current domain.
	     */
	    rc = 1;
	    if (domain != NULL) break;
	    /* get current domain */
	    rc = NetGetDCName(NULL, NULL, (LPBYTE *) &wDomain);
	    if (rc != 0) break;
	    domain = INT2PTR(-1); /* repeat once */
	}
	if (rc == 0) {
	    DWORD i, size = MAX_PATH;
	    wHomeDir = uiPtr->usri1_home_dir;
	    if ((wHomeDir != NULL) && (wHomeDir[0] != L'\0')) {
		size = lstrlenW(wHomeDir);
		Tcl_UniCharToUtfDString(wHomeDir, size, bufferPtr);

	    } else {
		/*
		 * User exists but has no home dir. Return
		 * "{GetProfilesDirectory}/<user>".
		 */

		GetProfilesDirectoryW(buf, &size);



		Tcl_UniCharToUtfDString(buf, size-1, bufferPtr);
		Tcl_DStringAppend(bufferPtr, "/", 1);
		Tcl_DStringAppend(bufferPtr, name, nameLen);
	    }
	    result = Tcl_DStringValue(bufferPtr);
	    /* be sure we returns normalized path */
	    for (i = 0; i < size; ++i){
		if (result[i] == '\\') result[i] = '/';
	    }
	    NetApiBufferFree((void *) uiPtr);
	}
	Tcl_DStringFree(&ds);
    }
    if (wDomain != NULL) {
	NetApiBufferFree((void *) wDomain);
    }

Changes to win/tclWinInit.c.

498
499
500
501
502
503
504





















505
506
507
508
509
510
511
...
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
...
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
{
    Tcl_DStringInit(bufPtr);
    Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
    wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
    Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    return Tcl_DStringValue(bufPtr);
}





















 
/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
 *	Performs platform-specific interpreter initialization related to the
................................................................................
    union {
	SYSTEM_INFO info;
	OemId oemId;
    } sys;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    Tcl_DString ds;
    TCHAR szUserName[UNLEN+1];
    DWORD cchUserNameLen = UNLEN;

    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
	int(__stdcall *getversion)(void *) =
................................................................................

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.
     */

    Tcl_DStringInit(&ds);
    if (TclGetEnv("USERNAME", &ds) == NULL) {
	if (GetUserName(szUserName, &cchUserNameLen) != 0) {
	    int cbUserNameLen = cchUserNameLen - 1;
	    cbUserNameLen *= sizeof(TCHAR);
	    Tcl_WinTCharToUtf(szUserName, cbUserNameLen, &ds);
	}
    }
    Tcl_SetVar2(interp, "tcl_platform", "user", Tcl_DStringValue(&ds),
	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







 







<
<







 







|
<
<
<
<
<
<
<
|







498
499
500
501
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
...
550
551
552
553
554
555
556


557
558
559
560
561
562
563
...
624
625
626
627
628
629
630
631







632
633
634
635
636
637
638
639
{
    Tcl_DStringInit(bufPtr);
    Tcl_DStringSetLength(bufPtr, 2+TCL_INTEGER_SPACE);
    wsprintfA(Tcl_DStringValue(bufPtr), "cp%d", GetACP());
    Tcl_DStringSetLength(bufPtr, strlen(Tcl_DStringValue(bufPtr)));
    return Tcl_DStringValue(bufPtr);
}
 
const char *
TclpGetUserName(
    Tcl_DString *bufferPtr)	/* Uninitialized or free DString filled with
				 * the name of user. */
{
    Tcl_DStringInit(bufferPtr);

    if (TclGetEnv("USERNAME", bufferPtr) == NULL) {
	TCHAR szUserName[UNLEN+1];
	DWORD cchUserNameLen = UNLEN;

	if (!GetUserName(szUserName, &cchUserNameLen)) {
	    return NULL;
	}
	cchUserNameLen--;
	cchUserNameLen *= sizeof(TCHAR);
	Tcl_WinTCharToUtf(szUserName, cchUserNameLen, bufferPtr);
    }
    return Tcl_DStringValue(bufferPtr);
}
 
/*
 *---------------------------------------------------------------------------
 *
 * TclpSetVariables --
 *
 *	Performs platform-specific interpreter initialization related to the
................................................................................
    union {
	SYSTEM_INFO info;
	OemId oemId;
    } sys;
    static OSVERSIONINFOW osInfo;
    static int osInfoInitialized = 0;
    Tcl_DString ds;



    Tcl_SetVar2Ex(interp, "tclDefaultLibrary", NULL,
	    TclGetProcessGlobalValue(&defaultLibraryDir), TCL_GLOBAL_ONLY);

    if (!osInfoInitialized) {
	HMODULE handle = GetModuleHandle(TEXT("NTDLL"));
	int(__stdcall *getversion)(void *) =
................................................................................

    /*
     * Initialize the user name from the environment first, since this is much
     * faster than asking the system.
     * Note: cchUserNameLen is number of characters including nul terminator.
     */

    ptr = TclpGetUserName(&ds);







    Tcl_SetVar2(interp, "tcl_platform", "user", ptr ? ptr : "",
	    TCL_GLOBAL_ONLY);
    Tcl_DStringFree(&ds);

    /*
     * Define what the platform PATH separator is. [TIP #315]
     */

Changes to win/tclWinInt.h.

59
60
61
62
63
64
65


66
67
68
69
70
71
72
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const TCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
			    const TCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const TCHAR *LinkOriginal,
			    int linkOnly);
MODULE_SCOPE int        TclWinFileOwned(Tcl_Obj *);



/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif

/*







>
>







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
MODULE_SCOPE HANDLE	TclWinSerialOpen(HANDLE handle, const TCHAR *name,
			    DWORD access);
MODULE_SCOPE int	TclWinSymLinkCopyDirectory(const TCHAR *LinkOriginal,
			    const TCHAR *LinkCopy);
MODULE_SCOPE int	TclWinSymLinkDelete(const TCHAR *LinkOriginal,
			    int linkOnly);
MODULE_SCOPE int        TclWinFileOwned(Tcl_Obj *);

MODULE_SCOPE const char*TclpGetUserName(Tcl_DString *bufferPtr);

/* Needed by tclWinFile.c and tclWinFCmd.c */
#ifndef FILE_ATTRIBUTE_REPARSE_POINT
#define FILE_ATTRIBUTE_REPARSE_POINT 0x00000400
#endif

/*

Changes to win/tclWinThrd.c.

37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
...
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
...
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
...
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
static CRITICAL_SECTION initLock;

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

#if !defined(TCL_THREADS) || TCL_THREADS

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

................................................................................
 * Condition Variable implementation.
 */

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

#if !defined(TCL_THREADS) || 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;
................................................................................
 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if !defined(TCL_THREADS) || TCL_THREADS
    if (!allocOnce) {
	InitializeCriticalSection(&allocLock.crit);
	allocOnce = 1;
    }
    return &allocLockPtr;
#else
    return NULL;
................................................................................
    /*
     * Destroy the critical section that we are holding!
     */

    DeleteCriticalSection(&masterLock);
    initialized = 0;

#if !defined(TCL_THREADS) || TCL_THREADS
    if (allocOnce) {
	DeleteCriticalSection(&allocLock.crit);
	allocOnce = 0;
    }
#endif

    LeaveCriticalSection(&initLock);
................................................................................
    /*
     * Destroy the critical section that we were holding.
     */

    DeleteCriticalSection(&initLock);
}
 
#if !defined(TCL_THREADS) || TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(ClientData data);
 
/*
 *----------------------------------------------------------------------
 *







|







 







|







 







|







 







|







 







|







37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
..
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
...
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
...
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
...
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
static CRITICAL_SECTION initLock;

/*
 * 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;
static int allocOnce = 0;

................................................................................
 * 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;
................................................................................
 *
 *----------------------------------------------------------------------
 */

Tcl_Mutex *
Tcl_GetAllocMutex(void)
{
#if TCL_THREADS
    if (!allocOnce) {
	InitializeCriticalSection(&allocLock.crit);
	allocOnce = 1;
    }
    return &allocLockPtr;
#else
    return NULL;
................................................................................
    /*
     * Destroy the critical section that we are holding!
     */

    DeleteCriticalSection(&masterLock);
    initialized = 0;

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

    LeaveCriticalSection(&initLock);
................................................................................
    /*
     * Destroy the critical section that we were holding.
     */

    DeleteCriticalSection(&initLock);
}
 
#if TCL_THREADS

/* locally used prototype */
static void		FinalizeConditionEvent(ClientData data);
 
/*
 *----------------------------------------------------------------------
 *