Tcl Source Code

Check-in [0d20ee5cfe]
Login

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

Overview
Comment:merge trunk
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | tip-389-impl
Files: files | file ages | folders
SHA1: 0d20ee5cfe021577bbc8fffef6ebbe48c2ed1d6c
User & Date: jan.nijtmans 2012-04-22 20:51:02
Context
2012-09-26
12:00
Merge trunk check-in: b2aae08f2d user: jan.nijtmans tags: tip-389-impl
2012-04-22
20:51
merge trunk check-in: 0d20ee5cfe user: jan.nijtmans tags: tip-389-impl
2012-04-19
10:28
Added example to platform(n) manpage check-in: 77ebc079e2 user: dkf tags: trunk
2012-02-03
21:25
merge trunk check-in: ffb46b40ba user: jan.nijtmans tags: tip-389-impl
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to ChangeLog.























































































































































































































































































































































1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20






















































































































































































































































































































































2012-02-02  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c: [Frq 3464401] Support Unicode 6.1
	* generic/regc_locale.c:

2012-02-02  Don Porter  <[email protected]>

	* win/tclWinFile.c:	[Bugs 2974459,2879351,1951574,1852572,
	1661378,1613456]: Revisions to the NativeAccess() routine that
	queries file permissions on Windows native filesystems.  Meant to
	fix numerous bugs where [file writable|readable|executable] "lies"
	about what operations are possible, especially when the file resides
	on a Samba share.

2012-02-01  Donal K. Fellows  <[email protected]>

	* doc/AddErrInfo.3: [Bug 3482614]: Documentation nit.

2012-01-30  Donal K. Fellows  <[email protected]>

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


|





|
|
|
|
|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
2012-04-18  Kevin B. Kenny  <[email protected]>

	* library/tzdata/Africa/Casablanca:
	* library/tzdata/America/Port-au-Prince:
	* library/tzdata/Asia/Damascus:
	* library/tzdata/Asia/Gaza:
	* library/tzdata/Asia/Hebron: tzdata2012c

2012-04-16  Donal K. Fellows  <[email protected]>

	* doc/FileSystem.3 (Tcl_FSOpenFileChannelProc): [Bug 3518244]: Fixed
	documentation of this filesystem callback function; it must not
	register its created channel - that's the responsibility of the caller
	of Tcl_FSOpenFileChannel - as that leads to reference leaks.

2012-04-15  Donal K. Fellows  <[email protected]>

	* generic/tclEnsemble.c (NsEnsembleImplementationCmdNR):
	* generic/tclIOUtil.c (Tcl_FSEvalFileEx): Cut out levels of the C
	stack by going direct to the relevant internal evaluation function.

	* generic/tclZlib.c (ZlibTransformSetOption): [Bug 3517696]: Make
	flushing work correctly in a pushed compressing channel transform.

2012-04-12  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3514475]: Remove TclpGetTimeZone and
	* generic/tclIntDecls.h:     TclpGetTZName
	* generic/tclIntPlatDecls.h:
	* generic/tclStubInit.c:
	* unix/tclUnixTime.c:
	* unix/tclWinTilemc:

2012-04-11  Jan Nijtmans  <[email protected]>

	* win/tclWinInit.c:     [Bug 3448512]: clock scan "1958-01-01" fails
	* win/tcl.m4:           only in debug compilation.
	* win/configure:
	* unix/tcl.m4:          Use NDEBUG consistantly meaning: no debugging.
	* unix/configure:
	* generic/tclBasic.c:
	* library/dde/pkgIndex.tcl   Use [::tcl::pkgconfig get debug] instead
	* library/reg/pkgIndex.tcl   of [info exists ::tcl_platform(debug)]

2012-04-10  Donal K. Fellows  <[email protected]>

	* generic/tcl.h (TCL_DEPRECATED_API): [Bug 2458976]: Added macro that
	can be used to mark parts of Tcl's API as deprecated. Currently only
	used for fields of Tcl_Interp, which TIPs 330 and 336 have deprecated
	with a migration strategy; we want to encourage people to move away
	from those fields.

2012-04-09  Donal K. Fellows  <[email protected]>

	* generic/tclOODefineCmds.c (ClassVarsSet, ObjVarsSet): [Bug 3396896]:
	Ensure that the lists of variable names used to drive variable
	resolution will never have the same name twice.

	* generic/tclVar.c (AppendLocals): [Bug 2712377]: Fix problem with
	reporting of declared variables in methods. It's really a problem with
	how [info vars] interacts with variable resolvers; this is just a bit
	of a hack so it is no longer a big problem.

2012-04-04  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance):
	[Bug 3514761]: Fixed bogosity with automated argument description
	handling when constructing an instance of a class that is itself a
	member of an ensemble. Thanks to Andreas Kupries for identifying that
	this was a problem case at all!
	(Tcl_CopyObjectInstance): Fix potential bleed-over of ensemble
	information into [oo::copy].

2012-04-04  Jan Nijtmans  <[email protected]>

	* win/tclWinSock.c: [Bug 510001]: TclSockMinimumBuffers needs plat imp
	* generic/tclIOSock.c:
	* generic/tclInt.decls:
	* generic/tclIntDecls.h:
	* generic/tclStubInit.c:

2012-04-03  Jan Nijtmans  <[email protected]>

	* generic/tclStubInit.c: Remove the TclpGetTZName implementation for
	* generic/tclIntDecls.h: Cygwin (from 2012-04-02 commit), re-generated
	* generic/tclIntPlatDecls.h:

2012-04-02  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#396.

	* generic/tclBasic.c (builtInCmds, TclNRYieldToObjCmd): Convert the
	formerly-unsupported yieldm and yieldTo commands into [yieldto].

2012-04-02  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls: [Bug 3508771]: load tclreg.dll in cygwin tclsh
	* generic/tclIntPlatDecls.h: Implement TclWinGetTclInstance,
	* generic/tclStubInit.c:     TclpGetTZName, and various more
	win32-specific internal functions for Cygwin, so win32 extensions
	using those can be loaded in the cygwin version of tclsh.

2012-03-30  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:        [Bug 3511806]: Compiler checks too early
	* unix/configure.in:  This change allows to build the cygwin and
	* unix/tclUnixPort.h: mingw32 ports of Tcl/Tk to build out-of-the-box
	* win/tcl.m4:         using a native or cross-compiler.
	* win/configure.in:
	* win/tclWinPort.h:
	* win/README          Document how to build win32 or win64 executables
	with Linux, Cygwin or Darwin.

2012-03-29  Jan Nijtmans  <[email protected]>

	* generic/tclCmdMZ.c (StringIsCmd): Faster mem-leak free
	implementation of [string is entier].

2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#395.

	* generic/tclCmdMZ.c (StringIsCmd): Implementation of the [string is
	entier] check. Code by Jos Decoster.

2012-03-27  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:      [Bug 3508771]: Wrong Tcl_StatBuf used on MinGW.
	* generic/tclFCmd.c:  [Bug 2015723]: Duplicate inodes from file stat
	* generic/tclCmdAH.c: on windows (but now for cygwin as well).
	* generic/tclOODefineCmds.c: minor gcc warning
	* win/tclWinPort.h:   Use lower numbers, preventing integer overflow.
	Remove the workaround for mingw-w64 [bug 3407992]. It's long fixed.

2012-03-27  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#397.

	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: Make the
	target object name optional when copying classes. [RFE 3485060]: Add
	callback method ("<cloned>") so that scripted control over copying is
	easier.
	***POTENTIAL INCOMPATIBILITY***
	If you'd previously been using the "<cloned>" method name, this now
	has a standard semantics and call interface. Only a problem if you are
	also using [oo::copy].

2012-03-26  Donal K. Fellows  <[email protected]>

	IMPLEMENTATION OF TIP#380.

	* doc/define.n, doc/object.n, generic/tclOO.c, generic/tclOOBasic.c:
	* generic/tclOOCall.c, generic/tclOODefineCmds.c, generic/tclOOInt.h:
	* tests/oo.test: Switch definitions of lists of things in objects and
	classes to a slot-based approach, which gives a lot more flexibility
	and programmability at the script-level. Introduce new [::oo::Slot]
	class which is the implementation of these things.

	***POTENTIAL INCOMPATIBILITY***
	The unknown method handler now may be asked to deal with the case
	where no method name is provided at all. The default implementation
	generates a compatible error message, and any override that forces the
	presence of a first argument (i.e., a method name) will continue to
	function as at present as well, so this is a pretty small change.

	* generic/tclOOBasic.c (TclOO_Object_Destroy): Made it easier to do a
	tailcall inside a normally-invoked destructor; prevented leakage out
	to calling command.

2012-03-25  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:      [Bug 3508771]: load tclreg.dll in cygwin
	* generic/tclIntPlatDecls.h: tclsh. Implement TclWinConvertError,
	* generic/tclStubInit.c:     TclWinConvertWSAError, and various more
	* unix/Makefile.in:          win32-specific internal functions for
	* unix/tcl.m4:               Cygwin, so win32 extensions using those
	* unix/configure:            can be loaded in the cygwin version of
	* win/tclWinError.c:         tclsh.

2012-03-23  Jan Nijtmans  <[email protected]>

	* generic/tclInt.decls:       Revert some cygwin-related signature
	* generic/tclIntPlatDecls.h:  changes from [835f8e1e9d] (2010-01-22).
	* win/tclWinError.c:          They were an attempt to make the cygwin
	                              port compile again, but since cygwin is
	                              based on unix this serves no purpose any
	                              more.
	* win/tclWinSerial.c:         Use EAGAIN in stead of EWOULDBLOCK,
	* win/tclWinSock.c:           because in VS10+ the value of
	                              EWOULDBLOCK is no longer the same as
	                              EAGAIN.
	* unix/Makefile.in:           Add tclWinError.c to the CYGWIN build.
	* unix/tcl.m4:
	* unix/configure:

2012-03-20  Jan Nijtmans  <[email protected]>

	* generic/tcl.decls:         [Bug 3508771]: load tclreg.dll in cygwin
	* generic/tclInt.decls:      tclsh. Implement TclWinGetPlatformId,
	* generic/tclIntPlatDecls.h: Tcl_WinUtfToTChar, Tcl_WinTCharToUtf (and
	* generic/tclPlatDecls.h:    a dummy TclWinCPUID) for Cygwin, so win32
	* generic/tclStubInit.c:     extensions using those can be loaded in
	* unix/tclUnixCompat.c:      the cygwin version of tclsh.

2012-03-19  Venkat Iyer <[email protected]>

	* library/tzdata/America/Atikokan: Update to tzdata2012b.
	* library/tzdata/America/Blanc-Sablon
	* library/tzdata/America/Dawson_Creek
	* library/tzdata/America/Edmonton
	* library/tzdata/America/Glace_Bay
	* library/tzdata/America/Goose_Bay
	* library/tzdata/America/Halifax
	* library/tzdata/America/Havana
	* library/tzdata/America/Moncton
	* library/tzdata/America/Montreal
	* library/tzdata/America/Nipigon
	* library/tzdata/America/Rainy_River
	* library/tzdata/America/Regina
	* library/tzdata/America/Santiago
	* library/tzdata/America/St_Johns
	* library/tzdata/America/Swift_Current
	* library/tzdata/America/Toronto
	* library/tzdata/America/Vancouver
	* library/tzdata/America/Winnipeg
	* library/tzdata/Antarctica/Casey
	* library/tzdata/Antarctica/Davis
	* library/tzdata/Antarctica/Palmer
	* library/tzdata/Asia/Yerevan
	* library/tzdata/Atlantic/Stanley
	* library/tzdata/Pacific/Easter
	* library/tzdata/Pacific/Fakaofo
	* library/tzdata/America/Creston: (new)

2012-03-19  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (Tcl_OpenTcpServer): Use the values returned
	by getaddrinfo() for all three arguments to socket() instead of
	only using ai_family. Try to keep the most meaningful error while
	iterating over the result list, because using the last error can
	be misleading.

2012-03-15  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: [Bug 3288345]: Wrong Tcl_StatBuf used on Cygwin
	* unix/tclUnixFile.c
	* unix/tclUnixPort.h
	* win/cat.c:           Remove cygwin stuff no longer needed
	* win/tclWinFile.c
	* win/tclWinPort.h

2012-03-12  Jan Nijtmans  <[email protected]>

	* win/tclWinFile.c: [Bug 3388350]: mingw64 compiler warnings

2012-03-11  Donal K. Fellows  <[email protected]>

	* doc/*.n, doc/*.3: A number of small spelling and wording fixes.

2012-03-08  Donal K. Fellows  <[email protected]>

	* doc/info.n:   Various minor fixes (prompted by Andreas Kupries
	* doc/socket.n: detecting a spelling mistake).

2012-03-07  Andreas Kupries  <[email protected]>

	* library/http/http.tcl: [Bug 3498327]: Generate upper-case
	* library/http/pkgIndex.tcl: hexadecimal output for compliance
	* tests/http.test: with RFC 3986. Bumped version to 2.8.4.
	* unix/Makefile.in:
	* win/Makefile.in:

2012-03-06  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: Compatibility with older Visual Studio versions.

2012-03-04  Jan Nijtmans  <[email protected]>

	* generic/tclLoad.c: Patch from the cygwin folks
	* unix/tcl.m4:
	* unix/configure: (re-generated)

2012-03-02  Donal K. Fellows  <[email protected]>

	* generic/tclBinary.c (Tcl_SetByteArrayObj): [Bug 3496014]: Only zero
	out the memory block if it is not being immediately overwritten. (Our
	caller might still overwrite, but we should at least avoid
	known-useless work.)

2012-02-29  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c:	[Bug 3466099]: BOM in Unicode
	* generic/tclEncoding.c:
	* tests/source.test

2012-02-23  Donal K. Fellows  <[email protected]>

	* tests/reg.test (14.21-23): Add tests relating to Bug 1115587. Actual
	bug is characterised by test marked with 'knownBug'.

2012-02-17  Jan Nijtmans  <[email protected]>

	* generic/tclIOUtil.c: [Bug 2233954]: AIX: compile error
	* unix/tclUnixPort.h:

2012-02-16  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (INST_LIST_RANGE_IMM): Enhance implementation
	so that shortening a (not multiply-referenced) list by lopping the end
	off with [lrange] or [lreplace] is efficient.

2012-02-15  Donal K. Fellows  <[email protected]>

	* generic/tclCompCmds.c (TclCompileLreplaceCmd): Added a compilation
	strategy for [lreplace] that tackles the cases which are equivalent to
	a static [lrange].
	(TclCompileLrangeCmd): Add compiler for [lrange] with constant indices
	so we can take advantage of existing TCL_LIST_RANGE_IMM opcode.
	(TclCompileLindexCmd): Improve coverage of constant-index-style
	compliation using technique developed for [lrange] above.

	(TclCompileDictForCmd): [Bug 3487626]: Fix crash in compilation of
	[dict for] when its implementation command is used directly rather
	than through the ensemble.

2012-02-09  Don Porter  <[email protected]>

	* generic/tclStringObj.c:	Converted the memcpy() calls in append
	operations to memmove() calls.  This adds safety in the case of
	overlapping copies, and improves performance on some benchmarks.

2012-02-06  Don Porter  <[email protected]>

	* generic/tclEnsemble.c: [Bug 3485022]: TclCompileEnsemble() avoid
	* tests/trace.test:	compile when exec traces set.

2012-02-06  Miguel Sofer  <[email protected]>

	* generic/tclTrace.c:  [Bug 3484621]: Ensure that execution traces on
	* tests/trace.test:    bytecoded commands bump the interp's compile
	epoch.

2012-02-02  Jan Nijtmans  <[email protected]>

	* generic/tclUniData.c: [FRQ 3464401]: Support Unicode 6.1
	* generic/regc_locale.c:

2012-02-02  Don Porter  <[email protected]>

	* win/tclWinFile.c:	[Bugs 2974459,2879351,1951574,1852572,
	1661378,1613456]: Revisions to the NativeAccess() routine that queries
	file permissions on Windows native filesystems.  Meant to fix numerous
	bugs where [file writable|readable|executable] "lies" about what
	operations are possible, especially when the file resides on a Samba
	share.

2012-02-01  Donal K. Fellows  <[email protected]>

	* doc/AddErrInfo.3: [Bug 3482614]: Documentation nit.

2012-01-30  Donal K. Fellows  <[email protected]>

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
	copying an object, make sure that the configuration of the variable
	resolver is also duplicated.

2012-01-22  Jan Nijtmans  <[email protected]>

	* tools/uniClass.tcl:    [FRQ 3473670]: Various Unicode-related
	* tools/uniParse.tcl:    speedups/robustness. Enhanced tools to
	* generic/tclUniData.c:  be able to handle characters > 0xffff
	* generic/tclUtf.c:      Done in all branches in order to simplify
	* generic/regc_locale.c: merges for new Unicode versions (such as 6.1)

2012-01-22  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictExistsCmd): [Bug 3475264]: Ensure that
	errors only ever happen when insufficient arguments are supplied, and
	not when a path doesn't exist or a dictionary is poorly formatted (the
	two cases can't be easily distinguished).







|
|
|
|







383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
	* generic/tclOO.c (Tcl_CopyObjectInstance): [Bug 3474460]: When
	copying an object, make sure that the configuration of the variable
	resolver is also duplicated.

2012-01-22  Jan Nijtmans  <[email protected]>

	* tools/uniClass.tcl:    [FRQ 3473670]: Various Unicode-related
	* tools/uniParse.tcl:    speedups/robustness. Enhanced tools to be
	* generic/tclUniData.c:  able to handle characters > 0xffff. Done in
	* generic/tclUtf.c:      all branches in order to simplify merges for
	* generic/regc_locale.c: new Unicode versions (such as 6.1)

2012-01-22  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (DictExistsCmd): [Bug 3475264]: Ensure that
	errors only ever happen when insufficient arguments are supplied, and
	not when a path doesn't exist or a dictionary is poorly formatted (the
	two cases can't be easily distinguished).
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173

	* tools/uniParse.tcl:    [Bug 3444754]: string tolower \u01c5 is wrong
	* generic/tclUniData.c:
	* tests/utf.test:

2011-11-30  Jan Nijtmans  <[email protected]>

	* library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work
	when tclsh is compiled without using the setargv() function on mingw.
	(no need to incr the version, since 2.2.10 is never released)

2011-11-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: don't install tommath_(super)?class.h
	* unix/Makefile.in: don't install directories like 8.2 and 8.3
	* generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from
	* generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h

2011-11-25  Donal K. Fellows  <[email protected]>

	* library/history.tcl (history): Simplify the dance of variable
	management used when chaining to the implementation command.

2011-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclCompileObj): Simplify and de-indent the
	logic so that it is easier to comprehend.

2011-11-22  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h:   [Bug 2935503]: Windows: file mtime
	* win/tclWinFile.c:  sets wrong time (VS2005+ only)
	* generic/tclTest.c:

2011-11-20  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove unnecessary [after] calls from the thread
	tests.  Make error message matching more robust for tests that may
	have built-in race conditions.  Test thread-7.26 must first unset all







|
|
|




















|
|







477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515

	* tools/uniParse.tcl:    [Bug 3444754]: string tolower \u01c5 is wrong
	* generic/tclUniData.c:
	* tests/utf.test:

2011-11-30  Jan Nijtmans  <[email protected]>

	* library/tcltest/tcltest.tcl: [Bug 967195]: Make tcltest work when
	tclsh is compiled without using the setargv() function on mingw (No
	need to incr the version, since 2.2.10 is never released).

2011-11-29  Jan Nijtmans  <[email protected]>

	* win/Makefile.in: don't install tommath_(super)?class.h
	* unix/Makefile.in: don't install directories like 8.2 and 8.3
	* generic/tclTomMath.h: [Bug 2991415]: move include tclInt.h from
	* generic/tclTomMathInt.h: tclTomMath.h to tclTomMathInt.h

2011-11-25  Donal K. Fellows  <[email protected]>

	* library/history.tcl (history): Simplify the dance of variable
	management used when chaining to the implementation command.

2011-11-22  Donal K. Fellows  <[email protected]>

	* generic/tclExecute.c (TclCompileObj): Simplify and de-indent the
	logic so that it is easier to comprehend.

2011-11-22  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 2935503]: Windows: [file mtime] sets wrong
	* win/tclWinFile.c: time (VS2005+ only).
	* generic/tclTest.c:

2011-11-20  Joe Mistachkin  <[email protected]>

	* tests/thread.test: Remove unnecessary [after] calls from the thread
	tests.  Make error message matching more robust for tests that may
	have built-in race conditions.  Test thread-7.26 must first unset all
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279

	* generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of
	qualified names, and added spacial cases for empty bodies (used when
	[dict with] is just used for extracting variables).

2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Fix gcc warnings (discovered with
	* generic/tclIORChan.c: latest mingw, based on gcc 4.6.1)
	* tests/env.test:       Fix env.test, when running
	under wine 1.3

2011-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
	compilation for the [dict with] subcommand, using parts factored out
	from the interpreted version of the command.







|
|
|
<







604
605
606
607
608
609
610
611
612
613

614
615
616
617
618
619
620

	* generic/tclCompCmds.c (TclCompileDictWithCmd): Corrected handling of
	qualified names, and added spacial cases for empty bodies (used when
	[dict with] is just used for extracting variables).

2011-10-07  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:        Fix gcc warnings (discovered with latest
	* generic/tclIORChan.c: mingw, based on gcc 4.6.1)
	* tests/env.test:       Fix env.test, when running under wine 1.3.


2011-10-06  Donal K. Fellows  <[email protected]>

	* generic/tclDictObj.c (TclDictWithInit, TclDictWithFinish):
	* generic/tclCompCmds.c (TclCompileDictWithCmd): Experimental
	compilation for the [dict with] subcommand, using parts factored out
	from the interpreted version of the command.
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
	make the main [file] command hidden by default in safe interpreters,
	because that's what existing code expects. This will reduce the amount
	which the code breaks, but not necessarily eliminate it...

2011-09-23  Don Porter  <[email protected]>

	* generic/tclIORTrans.c: More revisions to get finalization of
	ReflectedTransforms correct, including adopting a "dead" field as
	was done in tclIORChan.c.

	* tests/thread.test:	Stop using the deprecated thread management
	commands of the tcltest package.  The test suite ought to provide
	these tools for itself.  They do not belong in a testing harness.

2011-09-22  Don Porter  <[email protected]>








|
|







664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
	make the main [file] command hidden by default in safe interpreters,
	because that's what existing code expects. This will reduce the amount
	which the code breaks, but not necessarily eliminate it...

2011-09-23  Don Porter  <[email protected]>

	* generic/tclIORTrans.c: More revisions to get finalization of
	ReflectedTransforms correct, including adopting a "dead" field as was
	done in tclIORChan.c.

	* tests/thread.test:	Stop using the deprecated thread management
	commands of the tcltest package.  The test suite ought to provide
	these tools for itself.  They do not belong in a testing harness.

2011-09-22  Don Porter  <[email protected]>

346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
	* tools/tcltk-man2html-utils.tcl (process-text): Teach the HTML
	generator how to handle this magic.

2011-09-21  Don Porter  <[email protected]>

	* generic/tclThreadTest.c: Revise the thread exit handling of the
	[testthread] command so that it properly maintains the per-process
	data structures even when the thread exits for reasons other than
	the [testthread exit] command.

2011-09-21  Alexandre Ferrieux  <[email protected]>

	* unix/tclIO.c: [Bug 3412487]: Now short reads are allowed in
	synchronous fcopy, avoid mistaking them as nonblocking ones.

2011-09-21  Andreas Kupries  <[email protected]>







|
|







687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
	* tools/tcltk-man2html-utils.tcl (process-text): Teach the HTML
	generator how to handle this magic.

2011-09-21  Don Porter  <[email protected]>

	* generic/tclThreadTest.c: Revise the thread exit handling of the
	[testthread] command so that it properly maintains the per-process
	data structures even when the thread exits for reasons other than the
	[testthread exit] command.

2011-09-21  Alexandre Ferrieux  <[email protected]>

	* unix/tclIO.c: [Bug 3412487]: Now short reads are allowed in
	synchronous fcopy, avoid mistaking them as nonblocking ones.

2011-09-21  Andreas Kupries  <[email protected]>
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457

	* generic/tclCompExpr.c: [Bug 3408408]: Partial improvement by sharing
	as literals the computed values of constant subexpressions when we can
	do so without incurring the cost of string rep generation.

2011-09-13  Don Porter  <[email protected]>

	* generic/tclUtil.c:	[Bug 3390638]: Workaround broken solaris
	studio cc optimizer.  Thanks to Wolfgang S. Kechel.

	* generic/tclDTrace.d:	[Bug 3405652]: Portability workaround for
	broken system DTrace support.  Thanks to Dagobert Michelson.

2011-09-12  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with
	EOVERFLOW==E2BIG

2011-09-11  Don Porter  <[email protected]>

	* tests/thread.test:	Convert [testthread] use to Thread package
	use in thread-6.1.  Eliminates a memory leak in `make valgrind`.

	* tests/socket.test:	[Bug 3390699]: Convert [testthread] use to
	Thread package use in socket_*-13.1.  Eliminates a memory leak in
	`make valgrind`.

2011-09-09  Don Porter  <[email protected]>








|
|











|
|







770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798

	* generic/tclCompExpr.c: [Bug 3408408]: Partial improvement by sharing
	as literals the computed values of constant subexpressions when we can
	do so without incurring the cost of string rep generation.

2011-09-13  Don Porter  <[email protected]>

	* generic/tclUtil.c:	[Bug 3390638]: Workaround broken Solaris
	Studio cc optimizer.  Thanks to Wolfgang S. Kechel.

	* generic/tclDTrace.d:	[Bug 3405652]: Portability workaround for
	broken system DTrace support.  Thanks to Dagobert Michelson.

2011-09-12  Jan Nijtmans  <[email protected]>

	* win/tclWinPort.h: [Bug 3407070]: tclPosixStr.c won't build with
	EOVERFLOW==E2BIG

2011-09-11  Don Porter  <[email protected]>

	* tests/thread.test:	Convert [testthread] use to Thread package use
	in thread-6.1.  Eliminates a memory leak in `make valgrind`.

	* tests/socket.test:	[Bug 3390699]: Convert [testthread] use to
	Thread package use in socket_*-13.1.  Eliminates a memory leak in
	`make valgrind`.

2011-09-09  Don Porter  <[email protected]>

809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2011-07-15  Don Porter  <[email protected]>

	* generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats()
	is called in a deleted interp.

	* generic/tclCompile.c:	[Bug 467523, 3357771]: Prevent circular
	references in values with ByteCode intreps.  They can lead to
	memory leaks.

2011-07-14  Donal K. Fellows  <[email protected]>

	* generic/tclOOCall.c (TclOORenderCallChain): [Bug 3365156]: Remove
	stray refcount bump that caused a memory leak.

2011-07-12  Don Porter  <[email protected]>







|
|

|
|
|







1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
	* README:

	* unix/configure:	autoconf-2.59
	* win/configure:

2011-07-15  Don Porter  <[email protected]>

	* generic/tclCompile.c: Avoid segfaults when RecordByteCodeStats() is
	called in a deleted interp.

	* generic/tclCompile.c: [Bug 467523, 3357771]: Prevent circular
	references in values with ByteCode intreps.  They can lead to memory
	leaks.

2011-07-14  Donal K. Fellows  <[email protected]>

	* generic/tclOOCall.c (TclOORenderCallChain): [Bug 3365156]: Remove
	stray refcount bump that caused a memory leak.

2011-07-12  Don Porter  <[email protected]>
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
2011-06-28  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (CreateClientSocket): [Bug 3325339]: Fix and
	simplify posting of the writable fileevent at the end of an
	asynchronous connection attempt. Improve comments for some of the
	trickery around [socket -async].

	* tests/socket.test: Adjust tests to the async code changes. Add
	more tests for corner cases of async sockets.

2011-06-22  Andreas Kupries  <[email protected]>

	* library/platform/pkgIndex.tcl: Updated to platform 1.0.10. Added
	* library/platform/platform.tcl: handling of the DEB_HOST_MULTIARCH
	* unix/Makefile.in: location change for libc.
	* win/Makefile.in:

	* generic/tclInt.h: Fixed the inadvertently committed disabling of
	  stack checks, see my 2010-11-15 commit.

2011-06-22  Reinhard Max  <[email protected]>

	Merge from rmax-ipv6-branch:
	* unix/tclUnixSock.c: Fix [socket -async], so that all addresses
	returned by getaddrinfo() are tried, not just the first one. This
	requires the event loop to be running while the async connection
	is in progress. ***POTENTIAL INCOMPATIBILITY***
	* tests/socket.test: Add a test for the above.
	* doc/socket: Document the fact that -async needs the event loop
	* generic/tclIOSock.c: AI_ADDRCONFIG is broken on HP-UX

2011-06-21  Don Porter  <[email protected]>

	* generic/tclLink.c:	[Bug 3317466]: Prevent multiple links to a
	single Tcl variable when calling Tcl_LinkVar().

2011-06-13  Don Porter  <[email protected]>

	* generic/tclStrToD.c:  [Bug 3315098]: Mem leak fix from Gustaf Neumann.

2011-06-08  Andreas Kupries  <[email protected]>

	* generic/tclExecute.c: Reverted the fix for [Bug 3274728]
	committed on 2011-04-06 and replaced with one which is
	64bit-safe. The existing fix crashed tclsh on Windows 64bit.

2011-06-08  Donal K. Fellows  <[email protected]>

	* tests/fileSystem.test: Reduce the amount of use of duplication of
	complex code to perform common tests, and convert others to do the
	test result check directly using Tcltest's own primitives.

2011-06-06  Jan Nijtmans  <[email protected]>

	* tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail
	when the machine does not have support for ip6. Follow-up to checkin
	from 2011-05-11 by rmax.

2011-06-02  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Removed TclCleanupLiteralTable(), and old
	* generic/tclInt.h:	band-aid routine put in place while a fix
	* generic/tclLiteral.c:	for [Bug 994838] took shape.  No longer needed.

2011-06-02  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (TclInvalidateNsCmdLookup): [Bug 3185407]: Extend
	the set of epochs that are potentially bumped when a command is
	created, for a slight performance drop (in some circumstances) and
	improved semantics.

2011-06-01  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Using the two free data elements in NRCommand to
	store objc and objv - useful for debugging.

2011-06-01  Jan Nijtmans  <[email protected]>

	* generic/tclUtil.c:   Fix for [Bug 3309871]: Valgrind finds:
	invalid read in TclMaxListLength()

2011-05-31  Don Porter  <[email protected]>

	* generic/tclInt.h:	Use a complete growth algorithm for lists
	* generic/tclListObj.c:	so that length limits do not overconstrain
	* generic/tclStringObj.c:	by a factor of 2.  [Bug 3293874]:
	* generic/tclUtil.c:	Fix includes rooting all growth routines
	by default on a commone tunable parameter TCL_MIN_GROWTH.

2011-05-25  Don Porter  <[email protected]>

	* library/msgcat/msgcat.tcl:	Bump to msgcat 1.4.4.
	* library/msgcat/pkgIndex.tcl:
	* unix/Makefile.in
	* win/Makefile.in







|
|









|






|
|















|
|
|
















|
|















|
|



|
|
|
|
|







1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
2011-06-28  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (CreateClientSocket): [Bug 3325339]: Fix and
	simplify posting of the writable fileevent at the end of an
	asynchronous connection attempt. Improve comments for some of the
	trickery around [socket -async].

	* tests/socket.test: Adjust tests to the async code changes. Add more
	tests for corner cases of async sockets.

2011-06-22  Andreas Kupries  <[email protected]>

	* library/platform/pkgIndex.tcl: Updated to platform 1.0.10. Added
	* library/platform/platform.tcl: handling of the DEB_HOST_MULTIARCH
	* unix/Makefile.in: location change for libc.
	* win/Makefile.in:

	* generic/tclInt.h: Fixed the inadvertently committed disabling of
	stack checks, see my 2010-11-15 commit.

2011-06-22  Reinhard Max  <[email protected]>

	Merge from rmax-ipv6-branch:
	* unix/tclUnixSock.c: Fix [socket -async], so that all addresses
	returned by getaddrinfo() are tried, not just the first one. This
	requires the event loop to be running while the async connection is in
	progress. ***POTENTIAL INCOMPATIBILITY***
	* tests/socket.test: Add a test for the above.
	* doc/socket: Document the fact that -async needs the event loop
	* generic/tclIOSock.c: AI_ADDRCONFIG is broken on HP-UX

2011-06-21  Don Porter  <[email protected]>

	* generic/tclLink.c:	[Bug 3317466]: Prevent multiple links to a
	single Tcl variable when calling Tcl_LinkVar().

2011-06-13  Don Porter  <[email protected]>

	* generic/tclStrToD.c:  [Bug 3315098]: Mem leak fix from Gustaf Neumann.

2011-06-08  Andreas Kupries  <[email protected]>

	* generic/tclExecute.c: Reverted the fix for [Bug 3274728] committed
	on 2011-04-06 and replaced with one which is 64bit-safe. The existing
	fix crashed tclsh on Windows 64bit.

2011-06-08  Donal K. Fellows  <[email protected]>

	* tests/fileSystem.test: Reduce the amount of use of duplication of
	complex code to perform common tests, and convert others to do the
	test result check directly using Tcltest's own primitives.

2011-06-06  Jan Nijtmans  <[email protected]>

	* tests/socket.test: Add test constraint, so 6.2 and 6.3 don't fail
	when the machine does not have support for ip6. Follow-up to checkin
	from 2011-05-11 by rmax.

2011-06-02  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Removed TclCleanupLiteralTable(), and old
	* generic/tclInt.h:	band-aid routine put in place while a fix for
	* generic/tclLiteral.c:	[Bug 994838] took shape.  No longer needed.

2011-06-02  Donal K. Fellows  <[email protected]>

	* generic/tclInt.h (TclInvalidateNsCmdLookup): [Bug 3185407]: Extend
	the set of epochs that are potentially bumped when a command is
	created, for a slight performance drop (in some circumstances) and
	improved semantics.

2011-06-01  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c: Using the two free data elements in NRCommand to
	store objc and objv - useful for debugging.

2011-06-01  Jan Nijtmans  <[email protected]>

	* generic/tclUtil.c:   Fix for [Bug 3309871]: Valgrind finds: invalid
	read in TclMaxListLength().

2011-05-31  Don Porter  <[email protected]>

	* generic/tclInt.h:	  Use a complete growth algorithm for lists so
	* generic/tclListObj.c:	  that length limits do not overconstrain by a
	* generic/tclStringObj.c: factor of 2.  [Bug 3293874]: Fix includes
	* generic/tclUtil.c:	  rooting all growth routines by default on a
	common tunable parameter TCL_MIN_GROWTH.

2011-05-25  Don Porter  <[email protected]>

	* library/msgcat/msgcat.tcl:	Bump to msgcat 1.4.4.
	* library/msgcat/pkgIndex.tcl:
	* unix/Makefile.in
	* win/Makefile.in
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014

	* library/msgcat/msgcat.tcl (msgcat::mcset, msgcat::mcmset): Remove
	some useless code; [dict set] builds dictionary levels for us.

2011-05-17  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c (TclFixupForwardJump): Tracked down and fixed
	* generic/tclBasic.c (TclArgumentBCEnter): the cause of a violation
	of my assertion that 'ePtr->nline == objc' in TclArgumentBCEnter.
	When a bytecode was grown during jump fixup the pc -> command line
	mapping was not updated. When things aligned just wrong the mapping
	would direct command A to the data for command B, with a different
	number of arguments.

2011-05-11  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (TcpWatchProc): No need to check for server
	sockets here, as the generic server code already takes care of
	that.
	* tests/socket.test (accept): Add tests to make sure that this
	remains so.

2011-05-10  Don Porter  <[email protected]>

	* generic/tclInt.h:     New internal routines TclScanElement() and
	* generic/tclUtil.c:    TclConvertElement() are rewritten guts of
	machinery to produce string rep of lists.  The new routines avoid
	and correct [Bug 3173086].  See comments for much more detail.

	* generic/tclDictObj.c:         Update all callers.
	* generic/tclIndexObj.c:
	* generic/tclListObj.c:
	* generic/tclUtil.c:
	* tests/list.test:








|
|
|
|
|
|




|
<
|
|





|
|







1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338

1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354

	* library/msgcat/msgcat.tcl (msgcat::mcset, msgcat::mcmset): Remove
	some useless code; [dict set] builds dictionary levels for us.

2011-05-17  Andreas Kupries  <[email protected]>

	* generic/tclCompile.c (TclFixupForwardJump): Tracked down and fixed
	* generic/tclBasic.c (TclArgumentBCEnter): the cause of a violation of
	my assertion that 'ePtr->nline == objc' in TclArgumentBCEnter.  When a
	bytecode was grown during jump fixup the pc -> command line mapping
	was not updated. When things aligned just wrong the mapping would
	direct command A to the data for command B, with a different number of
	arguments.

2011-05-11  Reinhard Max  <[email protected]>

	* unix/tclUnixSock.c (TcpWatchProc): No need to check for server
	sockets here, as the generic server code already takes care of that.

	* tests/socket.test (accept): Add tests to make sure that this remains
	so.

2011-05-10  Don Porter  <[email protected]>

	* generic/tclInt.h:     New internal routines TclScanElement() and
	* generic/tclUtil.c:    TclConvertElement() are rewritten guts of
	machinery to produce string rep of lists.  The new routines avoid and
	correct [Bug 3173086].  See comments for much more detail.

	* generic/tclDictObj.c:         Update all callers.
	* generic/tclIndexObj.c:
	* generic/tclListObj.c:
	* generic/tclUtil.c:
	* tests/list.test:

1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
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
2011-05-07  Donal K. Fellows  <[email protected]>

	* generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API
	for result generation.

2011-05-07  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: fix USE_TCLALLOC so that it can be enabled
	* unix/Makefile.in: without editing the Makefile

2011-05-05  Don Porter  <[email protected]>

	* generic/tclListObj.c:	Stop generating string rep of dict when
	converting to list.  Tolerate NULL interps more completely.

2011-05-03  Don Porter  <[email protected]>

	* generic/tclUtil.c:	Tighten Tcl_SplitList().
	* generic/tclListObj.c:	Tighten SetListFromAny().
	* generic/tclDictObj.c:	Tighten SetDictFromAny().
	* tests/join.test:
	* tests/mathop.test:

2011-05-02  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Revised TclFindElement() interface.  The
	* generic/tclDictObj.c:	final argument had been bracePtr, the address
	* generic/tclListObj.c:	of a boolean var, where the caller can be told
	* generic/tclParse.c:	whether or not the parsed list element was
	* generic/tclUtil.c:	enclosed in braces.  In practice, no callers
	really care about that.  What the callers really want to know is
	whether the list element value exists as a literal substring of the
	string being parsed, or whether a call to TclCopyAndCollpase() is
	needed to produce the list element value.  Now the final argument
	is changed to do what callers actually need.  This is a better fit
	for the calls in tclParse.c, where now a good deal of post-processing
	checking for "naked backslashes" is no longer necessary.
	***POTENTIAL INCOMPATIBILITY***
	For any callers calling in via the internal stubs table who really
	do use the final argument explicitly to check for the enclosing brace
	scenario.  Simply looking for the braces where they must be is the
	revision available to those callers, and it will backport cleanly.

	* tests/parse.test:	Tests for expanded literals quoting detection.

	* generic/tclCompCmdsSZ.c:	New TclFindElement() is also a better
	fit for the [switch] compiler.

	* generic/tclInt.h:	Replace TclCountSpaceRuns() with
	* generic/tclListObj.c:	TclMaxListLength() which is the function we
	* generic/tclUtil.c:	actually want.
	* generic/tclCompCmdsSZ.c:

	* generic/tclCompCmdsSZ.c: Rewrite of parts of the switch compiler to
	better use the powers of TclFindElement() and do less parsing on
	its own.

2011-04-28  Don Porter  <[email protected]>

	* generic/tclInt.h:	New utility routines:
	* generic/tclParse.c:	TclIsSpaceProc() and
	* generic/tclUtil.c:	TclCountSpaceRuns()

	* generic/tclCmdMZ.c:	Use new routines to replace calls to
	* generic/tclListObj.c:	isspace() and their /* INTL */ risk.
	* generic/tclStrToD.c:
	* generic/tclUtf.c:
	* unix/tclUnixFile.c:

	* generic/tclStringObj.c:	Improved reaction to out of memory.

2011-04-27  Don Porter  <[email protected]>







|
|
















|
|
|





|
|
|
|

|
|














|
|




|
|

|
|







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
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
2011-05-07  Donal K. Fellows  <[email protected]>

	* generic/tclLoad.c (TclGetLoadedPackages): Convert to use Tcl_Obj API
	for result generation.

2011-05-07  Miguel Sofer  <[email protected]>

	* generic/tclInt.h: Fix USE_TCLALLOC so that it can be enabled without
	* unix/Makefile.in: editing the Makefile.

2011-05-05  Don Porter  <[email protected]>

	* generic/tclListObj.c:	Stop generating string rep of dict when
	converting to list.  Tolerate NULL interps more completely.

2011-05-03  Don Porter  <[email protected]>

	* generic/tclUtil.c:	Tighten Tcl_SplitList().
	* generic/tclListObj.c:	Tighten SetListFromAny().
	* generic/tclDictObj.c:	Tighten SetDictFromAny().
	* tests/join.test:
	* tests/mathop.test:

2011-05-02  Don Porter  <[email protected]>

	* generic/tclCmdMZ.c:	Revised TclFindElement() interface. The final
	* generic/tclDictObj.c:	argument had been bracePtr, the address of a
	* generic/tclListObj.c:	boolean var, where the caller can be told
	* generic/tclParse.c:	whether or not the parsed list element was
	* generic/tclUtil.c:	enclosed in braces.  In practice, no callers
	really care about that.  What the callers really want to know is
	whether the list element value exists as a literal substring of the
	string being parsed, or whether a call to TclCopyAndCollpase() is
	needed to produce the list element value.  Now the final argument is
	changed to do what callers actually need. This is a better fit for the
	calls in tclParse.c, where now a good deal of post-processing checking
	for "naked backslashes" is no longer necessary.
	***POTENTIAL INCOMPATIBILITY***
	For any callers calling in via the internal stubs table who really do
	use the final argument explicitly to check for the enclosing brace
	scenario.  Simply looking for the braces where they must be is the
	revision available to those callers, and it will backport cleanly.

	* tests/parse.test:	Tests for expanded literals quoting detection.

	* generic/tclCompCmdsSZ.c:	New TclFindElement() is also a better
	fit for the [switch] compiler.

	* generic/tclInt.h:	Replace TclCountSpaceRuns() with
	* generic/tclListObj.c:	TclMaxListLength() which is the function we
	* generic/tclUtil.c:	actually want.
	* generic/tclCompCmdsSZ.c:

	* generic/tclCompCmdsSZ.c: Rewrite of parts of the switch compiler to
	better use the powers of TclFindElement() and do less parsing on its
	own.

2011-04-28  Don Porter  <[email protected]>

	* generic/tclInt.h:	New utility routines:
	* generic/tclParse.c:	TclIsSpaceProc() and TclCountSpaceRuns()
	* generic/tclUtil.c:

	* generic/tclCmdMZ.c:	Use new routines to replace calls to isspace()
	* generic/tclListObj.c:	and their /* INTL */ risk.
	* generic/tclStrToD.c:
	* generic/tclUtf.c:
	* unix/tclUnixFile.c:

	* generic/tclStringObj.c:	Improved reaction to out of memory.

2011-04-27  Don Porter  <[email protected]>
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158

2011-04-18  Don Porter  <[email protected]>

	* generic/tclCmdIL.c:	Use ListRepPtr(.) and other cleanup.
	* generic/tclConfig.c:
	* generic/tclListObj.c:

	* generic/tclInt.h:	Define and use macros that test whether
	* generic/tclBasic.c:	a Tcl list value is canonical.
	* generic/tclUtil.c:

2011-04-18  Donal K. Fellows  <[email protected]>

	* doc/dict.n: [Bug 3288696]: Command summary was confusingly wrong
	when it came to [dict filter] with a 'value' filter.








|
|







1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498

2011-04-18  Don Porter  <[email protected]>

	* generic/tclCmdIL.c:	Use ListRepPtr(.) and other cleanup.
	* generic/tclConfig.c:
	* generic/tclListObj.c:

	* generic/tclInt.h:	Define and use macros that test whether a Tcl
	* generic/tclBasic.c:	list value is canonical.
	* generic/tclUtil.c:

2011-04-18  Donal K. Fellows  <[email protected]>

	* doc/dict.n: [Bug 3288696]: Command summary was confusingly wrong
	when it came to [dict filter] with a 'value' filter.

1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341

	* generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):
	More generation of errorCode information.

2011-03-28  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c, generic/tclConfig.c, generic/tclUtil.c: More
	generation of errorCode information, notably when lists are
	mis-parsed.

	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the
	error messages generated by the variable management code rather than
	creating our own.

2011-03-27  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjEx): fix performance issue,
	notably apparent in tclbench's "LIST lset foreach". Many thanks to
	twylite for patiently researching the issue and explaining it to
	me: a missing Tcl_ResetObjResult that causes unwanted sharing of
	the current result Tcl_Obj.

2011-03-26  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More
	generation of errorCode information.

	* generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:







|
<







|
|
|
|
|







1654
1655
1656
1657
1658
1659
1660
1661

1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680

	* generic/tclGetDate.y, generic/tclDate.c (TclClockOldscanObjCmd):
	More generation of errorCode information.

2011-03-28  Donal K. Fellows  <[email protected]>

	* generic/tclCmdMZ.c, generic/tclConfig.c, generic/tclUtil.c: More
	generation of errorCode information, notably when lists are mis-parsed


	* generic/tclCmdMZ.c (Tcl_RegexpObjCmd, Tcl_RegsubObjCmd): Use the
	error messages generated by the variable management code rather than
	creating our own.

2011-03-27  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjEx): fix performance issue, notably
	apparent in tclbench's "LIST lset foreach". Many thanks to Twylite for
	patiently researching the issue and explaining it to me: a missing
	Tcl_ResetObjResult that causes unwanted sharing of the current result
	Tcl_Obj.

2011-03-26  Donal K. Fellows  <[email protected]>

	* generic/tclNamesp.c (Tcl_Export, Tcl_Import, DoImport): More
	generation of errorCode information.

	* generic/tclCompExpr.c, generic/tclCompile.c, generic/tclExecute.c:
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
2011-03-16  Jan Nijtmans  <[email protected]>

	* generic/tclCkalloc.c: [Bug 3197864]: Pointer truncation on Win64
	TCL_MEM_DEBUG builds.

2011-03-16  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Some rewrites to eliminate calls to
	* generic/tclParse.c:	isspace() and their /* INTL */ risk.
	* generic/tclProc.c:

2011-03-16  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:    Make SHLIB_LD_LIBS='${LIBS}' the default and
	* unix/configure: set to "" on per-platform necessary basis.
	Backported from TEA, but kept all original platform code which was







|
|







1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
2011-03-16  Jan Nijtmans  <[email protected]>

	* generic/tclCkalloc.c: [Bug 3197864]: Pointer truncation on Win64
	TCL_MEM_DEBUG builds.

2011-03-16  Don Porter  <[email protected]>

	* generic/tclBasic.c:	Some rewrites to eliminate calls to isspace()
	* generic/tclParse.c:	and their /* INTL */ risk.
	* generic/tclProc.c:

2011-03-16  Jan Nijtmans  <[email protected]>

	* unix/tcl.m4:    Make SHLIB_LD_LIBS='${LIBS}' the default and
	* unix/configure: set to "" on per-platform necessary basis.
	Backported from TEA, but kept all original platform code which was
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595

	* generic/tclAssembly.c (new file):
	* generic/tclBasic.c (Tcl_CreateInterp):
	* generic/tclInt.h:
	* tests/assemble.test (new file):
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:  Merged dogeen-assembler-branch into HEAD.
	Since all functional changes are in the tcl::unsupported namespace,
	there's no reason to sequester this code on a separate branch.

2011-03-05  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: cleaner mem management for TEBCdata

	* generic/tclExecute.c:
	* tests/nre.test: Renamed BottomData to TEBCdata, so that the name
	refers to what it is rather than to its storage location.

	* generic/tclBasic.c:     Renamed struct TEOV_callback to
	* generic/tclCompExpr.c:  the more descriptive NRE_callback.
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclTest.c:

2011-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect)
	(ProcedureMethodCompiledVarDelete): [Bug 3185009]: Keep references to
	resolved object variables so that an unset doesn't leave any dangling
	pointers for code to trip over.

2011-03-01  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjv): missing a variable
	declaration in commented out non-optimised code, left for ref in
	checkin [b97b771b6d]

2011-03-03  Don Porter  <[email protected]>

	* generic/tclResult.c (Tcl_AppendResultVA):	Use the directive
	USE_INTERP_RESULT [TIP 330] to force compat with interp->result
	access, instead of the improvised hack USE_DIRECT_INTERP_RESULT_ACCESS
	from releases past.







|
|
|



|





|
|
















|
|
|







1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934

	* generic/tclAssembly.c (new file):
	* generic/tclBasic.c (Tcl_CreateInterp):
	* generic/tclInt.h:
	* tests/assemble.test (new file):
	* unix/Makefile.in:
	* win/Makefile.in:
	* win/makefile.vc:  Merged dogeen-assembler-branch into HEAD. Since
	all functional changes are in the tcl::unsupported namespace, there's
	no reason to sequester this code on a separate branch.

2011-03-05  Miguel Sofer  <[email protected]>

	* generic/tclExecute.c: Cleaner mem management for TEBCdata

	* generic/tclExecute.c:
	* tests/nre.test: Renamed BottomData to TEBCdata, so that the name
	refers to what it is rather than to its storage location.

	* generic/tclBasic.c:     Renamed struct TEOV_callback to the more
	* generic/tclCompExpr.c:  descriptive NRE_callback.
	* generic/tclCompile.c:
	* generic/tclExecute.c:
	* generic/tclInt.decls:
	* generic/tclInt.h:
	* generic/tclIntDecls.h:
	* generic/tclTest.c:

2011-03-04  Donal K. Fellows  <[email protected]>

	* generic/tclOOMethod.c (ProcedureMethodCompiledVarConnect)
	(ProcedureMethodCompiledVarDelete): [Bug 3185009]: Keep references to
	resolved object variables so that an unset doesn't leave any dangling
	pointers for code to trip over.

2011-03-01  Miguel Sofer  <[email protected]>

	* generic/tclBasic.c (TclNREvalObjv): Missing a variable declaration
	in commented out non-optimised code, left for ref in checkin
	[b97b771b6d]

2011-03-03  Don Porter  <[email protected]>

	* generic/tclResult.c (Tcl_AppendResultVA):	Use the directive
	USE_INTERP_RESULT [TIP 330] to force compat with interp->result
	access, instead of the improvised hack USE_DIRECT_INTERP_RESULT_ACCESS
	from releases past.
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627

	* generic/tclExecute.c (ExprObjCallback): Fix object leak

	* generic/tclExecute.c (TEBCresume): Store local var array and
	constants in automatic vars to reduce indirection, slight perf
	increase

	* generic/tclOOCall.c (TclOODeleteContext): Added missing '*' so
	that trunk compiles.

	* generic/tclBasic.c (TclNRRunCallbacks): [Patch 3168229]: Don't do
	the trampoline dance for commands that do not have an nreProc.

2011-03-01  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance)







|
|







1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966

	* generic/tclExecute.c (ExprObjCallback): Fix object leak

	* generic/tclExecute.c (TEBCresume): Store local var array and
	constants in automatic vars to reduce indirection, slight perf
	increase

	* generic/tclOOCall.c (TclOODeleteContext): Added missing '*' so that
	trunk compiles.

	* generic/tclBasic.c (TclNRRunCallbacks): [Patch 3168229]: Don't do
	the trampoline dance for commands that do not have an nreProc.

2011-03-01  Donal K. Fellows  <[email protected]>

	* generic/tclOO.c (Tcl_NewObjectInstance, TclNRNewObjectInstance)
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
	* win/configure:      (autoconf-2.59)
	* win/tclWin32Dll.c:  VS 2005 64-bit does not have intrin.h, and
	* generic/tclPanic.c: does not need it.

2011-01-07  Kevin B. Kenny  <[email protected]>

	* tests/util.test (util-15.*): Added test cases for floating point
	conversion of the largest denormal and the smallest normal number,
	to avoid any possibility of the failure suffered by PHP in the
	last couple of days. (They didn't fail, so no actual functional
	change.)

2011-01-05  Donal K. Fellows  <[email protected]>

	* tests/package.test, tests/pkg.test: Coalesce these tests into one
	file that is concerned with the package system. Convert to use
	tcltest2 properly.
	* tests/autoMkindex.test, tests/pkgMkIndex.test: Convert to use







|
|
|
<







2040
2041
2042
2043
2044
2045
2046
2047
2048
2049

2050
2051
2052
2053
2054
2055
2056
	* win/configure:      (autoconf-2.59)
	* win/tclWin32Dll.c:  VS 2005 64-bit does not have intrin.h, and
	* generic/tclPanic.c: does not need it.

2011-01-07  Kevin B. Kenny  <[email protected]>

	* tests/util.test (util-15.*): Added test cases for floating point
	conversion of the largest denormal and the smallest normal number, to
	avoid any possibility of the failure suffered by PHP in the last
	couple of days. (They didn't fail, so no actual functional change.)


2011-01-05  Donal K. Fellows  <[email protected]>

	* tests/package.test, tests/pkg.test: Coalesce these tests into one
	file that is concerned with the package system. Convert to use
	tcltest2 properly.
	* tests/autoMkindex.test, tests/pkgMkIndex.test: Convert to use
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842

	* generic/tclPanic.c:    Restore abort() as it was before.
	* win/tclWinFile.c:      [Patch 3124554]: Use ExitProcess() here, like
	in wish.

2010-12-14  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:	[Bug 3137454]: Tcl CVS HEAD does not build
	on GCC 3.

2010-12-14  Reinhard Max  <[email protected]>

	* win/tclWinSock.c (CreateSocket):         Swap the loops over
	* unix/tclUnixSock.c (CreateClientSocket): local and remote addresses,
	so that the system's address preference for the remote side decides
	which family gets tried first. Cleanup and clarify some of the
	comments.

2010-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:    [Bug 3135271]: Link error due to hidden
	* unix/tcl.m4:      symbols (CentOS 4.2)
	* unix/configure:   (autoconf-2.59)
	* win/tclWinFile.c:  Undocumented feature, only meant to be
	used by Tk_Main. See [Patch 3124554]: Move WishPanic from Tk to Tcl

2010-12-12  Stuart Cassoff  <[email protected]>

	* unix/tcl.m4: Better building on OpenBSD.
	* unix/configure: (autoconf-2.59)

2010-12-10  Jan Nijtmans  <[email protected]>







|
<














|
|







2149
2150
2151
2152
2153
2154
2155
2156

2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179

	* generic/tclPanic.c:    Restore abort() as it was before.
	* win/tclWinFile.c:      [Patch 3124554]: Use ExitProcess() here, like
	in wish.

2010-12-14  Jan Nijtmans  <[email protected]>

	* generic/tcl.h: [Bug 3137454]: Tcl CVS HEAD does not build on GCC 3.


2010-12-14  Reinhard Max  <[email protected]>

	* win/tclWinSock.c (CreateSocket):         Swap the loops over
	* unix/tclUnixSock.c (CreateClientSocket): local and remote addresses,
	so that the system's address preference for the remote side decides
	which family gets tried first. Cleanup and clarify some of the
	comments.

2010-12-13  Jan Nijtmans  <[email protected]>

	* generic/tcl.h:    [Bug 3135271]: Link error due to hidden
	* unix/tcl.m4:      symbols (CentOS 4.2)
	* unix/configure:   (autoconf-2.59)
	* win/tclWinFile.c:  Undocumented feature, only meant to be used by
	Tk_Main. See [Patch 3124554]: Move WishPanic from Tk to Tcl

2010-12-12  Stuart Cassoff  <[email protected]>

	* unix/tcl.m4: Better building on OpenBSD.
	* unix/configure: (autoconf-2.59)

2010-12-10  Jan Nijtmans  <[email protected]>
6200
6201
6202
6203
6204
6205
6206
6207
6208
6209
6210
6211
6212
6213
6214
	* tests/httpd11.test:        modes (normal, -channel and -handler)
	* makefiles:                 package version set to 2.8.0

2009-04-10  Daniel Steffen  <[email protected]>

	* unix/tclUnixChan.c:		TclUnixWaitForFile(): use FD_* macros
	* macosx/tclMacOSXNotify.c:	to manipulate select masks (Cassoff).
					[Bug 1960647]

	* unix/tclLoadDyld.c:		use RTLD_GLOBAL instead of RTLD_LOCAL.
					[Bug 1961211]

	* macosx/tclMacOSXNotify.c:	revise CoreFoundation notifier to allow
					embedding into applications that
					already have a CFRunLoop running and







|







6537
6538
6539
6540
6541
6542
6543
6544
6545
6546
6547
6548
6549
6550
6551
	* tests/httpd11.test:        modes (normal, -channel and -handler)
	* makefiles:                 package version set to 2.8.0

2009-04-10  Daniel Steffen  <[email protected]>

	* unix/tclUnixChan.c:		TclUnixWaitForFile(): use FD_* macros
	* macosx/tclMacOSXNotify.c:	to manipulate select masks (Cassoff).
					[Freq 1960647] [Bug 3486554]

	* unix/tclLoadDyld.c:		use RTLD_GLOBAL instead of RTLD_LOCAL.
					[Bug 1961211]

	* macosx/tclMacOSXNotify.c:	revise CoreFoundation notifier to allow
					embedding into applications that
					already have a CFRunLoop running and

Changes to doc/AddErrInfo.3.

104
105
106
107
108
109
110





111
112
113
114
115
116
117
118
119
120
121
122
123
124
125

126
127
128
129
130
131
132
dictionary.  Also, the entries for the keys \fB\-code\fR
and \fB\-level\fR will be adjusted if necessary to agree
with the value of \fIcode\fR.  The \fB(Tcl_Obj *)\fR returned
by \fBTcl_GetReturnOptions\fR points to an unshared
\fBTcl_Obj\fR with reference count of zero.  The dictionary
may be written to, either adding, removing, or overwriting
any entries in it, without the need to check for a shared object.





.PP
A typical usage for \fBTcl_GetReturnOptions\fR is to
retrieve the stack trace when script evaluation returns
\fBTCL_ERROR\fR, like so:
.PP
.CS
int code = Tcl_Eval(interp, script);
if (code == TCL_ERROR) {
    Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);  
    Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1);
    Tcl_Obj *stackTrace;
    Tcl_IncrRefCount(key);
    Tcl_DictObjGet(NULL, options, key, &stackTrace);
    Tcl_DecrRefCount(key);
    /* Do something with stackTrace */

}
.CE
.PP
\fBTcl_SetReturnOptions\fR sets the return options
of \fIinterp\fR to be \fIoptions\fR.  If \fIoptions\fR
contains any invalid value for any key, TCL_ERROR will
be returned, and the interp result will be set to an







>
>
>
>
>















>







104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
dictionary.  Also, the entries for the keys \fB\-code\fR
and \fB\-level\fR will be adjusted if necessary to agree
with the value of \fIcode\fR.  The \fB(Tcl_Obj *)\fR returned
by \fBTcl_GetReturnOptions\fR points to an unshared
\fBTcl_Obj\fR with reference count of zero.  The dictionary
may be written to, either adding, removing, or overwriting
any entries in it, without the need to check for a shared object.
As with any \fBTcl_Obj\fR with reference count of zero, it is up to
the caller to arrange for its disposal with \fBTcl_DecrRefCount\fR or
to a reference to it via \fBTcl_IncrRefCount\fR (or one of the many
functions that call that, notably including \fBTcl_SetObjResult\fR and
\fBTcl_SetVar2Ex\fR).
.PP
A typical usage for \fBTcl_GetReturnOptions\fR is to
retrieve the stack trace when script evaluation returns
\fBTCL_ERROR\fR, like so:
.PP
.CS
int code = Tcl_Eval(interp, script);
if (code == TCL_ERROR) {
    Tcl_Obj *options = \fBTcl_GetReturnOptions\fR(interp, code);  
    Tcl_Obj *key = Tcl_NewStringObj("-errorinfo", -1);
    Tcl_Obj *stackTrace;
    Tcl_IncrRefCount(key);
    Tcl_DictObjGet(NULL, options, key, &stackTrace);
    Tcl_DecrRefCount(key);
    /* Do something with stackTrace */
    Tcl_DecrRefCount(options);
}
.CE
.PP
\fBTcl_SetReturnOptions\fR sets the return options
of \fIinterp\fR to be \fIoptions\fR.  If \fIoptions\fR
contains any invalid value for any key, TCL_ERROR will
be returned, and the interp result will be set to an

Changes to doc/Class.3.

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
\fBTcl_CopyObjectInstance\fR which creates a copy of an object without running
any constructors.
.SH "OBJECT AND CLASS METADATA"
.PP
Every object and every class may have arbitrary amounts of metadata attached
to it, which the object or class attaches no meaning to beyond what is
described in a Tcl_ObjectMetadataType structure instance. Metadata to be
attached is described by the the type of the metadata (given in the
\fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR
argument) that are given to \fBTcl_ObjectSetMetadata\fR and
\fBTcl_ClassSetMetadata\fR, and a particular piece of metadata can be
retrieved given its type using \fBTcl_ObjectGetMetadata\fR and
\fBTcl_ClassGetMetadata\fR. If the \fImetadata\fR parameter to either
\fBTcl_ObjectSetMetadata\fR or \fBTcl_ClassSetMetadata\fR is NULL, the
metadata is removed if it was attached, and the results of







|







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
\fBTcl_CopyObjectInstance\fR which creates a copy of an object without running
any constructors.
.SH "OBJECT AND CLASS METADATA"
.PP
Every object and every class may have arbitrary amounts of metadata attached
to it, which the object or class attaches no meaning to beyond what is
described in a Tcl_ObjectMetadataType structure instance. Metadata to be
attached is described by the type of the metadata (given in the
\fImetaTypePtr\fR argument) and an arbitrary pointer (the \fImetadata\fR
argument) that are given to \fBTcl_ObjectSetMetadata\fR and
\fBTcl_ClassSetMetadata\fR, and a particular piece of metadata can be
retrieved given its type using \fBTcl_ObjectGetMetadata\fR and
\fBTcl_ClassGetMetadata\fR. If the \fImetadata\fR parameter to either
\fBTcl_ObjectSetMetadata\fR or \fBTcl_ClassSetMetadata\fR is NULL, the
metadata is removed if it was attached, and the results of

Changes to doc/CrtChannel.3.

207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
.PP
\fBTcl_CreateChannel\fR interacts with the code managing the standard
channels. Once a standard channel was initialized either through a
call to \fBTcl_GetStdChannel\fR or a call to \fBTcl_SetStdChannel\fR
closing this standard channel will cause the next call to
\fBTcl_CreateChannel\fR to make the new channel the new standard
channel too. See \fBTcl_StandardChannels\fR for a general treatise
about standard channels and the behaviour of the Tcl library with
regard to them.
.PP
\fBTcl_GetChannelInstanceData\fR returns the instance data associated with
the channel in \fIchannel\fR. This is the same as the \fIinstanceData\fR
argument in the call to \fBTcl_CreateChannel\fR that created this channel.
.PP
\fBTcl_GetChannelType\fR returns a pointer to the \fBTcl_ChannelType\fR







|







207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
.PP
\fBTcl_CreateChannel\fR interacts with the code managing the standard
channels. Once a standard channel was initialized either through a
call to \fBTcl_GetStdChannel\fR or a call to \fBTcl_SetStdChannel\fR
closing this standard channel will cause the next call to
\fBTcl_CreateChannel\fR to make the new channel the new standard
channel too. See \fBTcl_StandardChannels\fR for a general treatise
about standard channels and the behavior of the Tcl library with
regard to them.
.PP
\fBTcl_GetChannelInstanceData\fR returns the instance data associated with
the channel in \fIchannel\fR. This is the same as the \fIinstanceData\fR
argument in the call to \fBTcl_CreateChannel\fR that created this channel.
.PP
\fBTcl_GetChannelType\fR returns a pointer to the \fBTcl_ChannelType\fR

Changes to doc/DictObj.3.

58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Points to the key for the key/value pair being manipulated within the
dictionary object.
.AP Tcl_Obj **keyPtrPtr out
Points to a variable that will have the key from a key/value pair
placed within it.  May be NULL to indicate that the caller is not
interested in the key.
.AP Tcl_Obj *valuePtr in
Points to the value for the key/value pair being manipulate within the
dictionary object (or sub-object, in the case of
\fBTcl_DictObjPutKeyList\fR.)
.AP Tcl_Obj **valuePtrPtr out
Points to a variable that will have the value from a key/value pair
placed within it.  For \fBTcl_DictObjFirst\fR and
\fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is
not interested in the value.







|







58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
Points to the key for the key/value pair being manipulated within the
dictionary object.
.AP Tcl_Obj **keyPtrPtr out
Points to a variable that will have the key from a key/value pair
placed within it.  May be NULL to indicate that the caller is not
interested in the key.
.AP Tcl_Obj *valuePtr in
Points to the value for the key/value pair being manipulated within the
dictionary object (or sub-object, in the case of
\fBTcl_DictObjPutKeyList\fR.)
.AP Tcl_Obj **valuePtrPtr out
Points to a variable that will have the value from a key/value pair
placed within it.  For \fBTcl_DictObjFirst\fR and
\fBTcl_DictObjNext\fR, this may be NULL to indicate that the caller is
not interested in the value.

Changes to doc/Ensemble.3.

91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
prefix mapping dictionary in the ensemble. May be NULL if the mapping
dictionary is to be removed.
.AP Tcl_Obj **dictObjPtr out
Pointer to a variable into which to write the current ensemble mapping
dictionary.
.AP Tcl_Obj *listObj in
A list value to use for the list of formal pre-subcommand parameters, the
defined list of subcommands in the dictionary or the unknown subcommmand
handler command prefix. May be NULL if the subcommand list or unknown handler
are to be removed.
.AP Tcl_Obj **listObjPtr out
Pointer to a variable into which to write the current list of formal
pre-subcommand parameters, the defined list of subcommands or the current
unknown handler prefix.
.AP Tcl_Namespace **namespacePtrPtr out







|







91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
prefix mapping dictionary in the ensemble. May be NULL if the mapping
dictionary is to be removed.
.AP Tcl_Obj **dictObjPtr out
Pointer to a variable into which to write the current ensemble mapping
dictionary.
.AP Tcl_Obj *listObj in
A list value to use for the list of formal pre-subcommand parameters, the
defined list of subcommands in the dictionary or the unknown subcommand
handler command prefix. May be NULL if the subcommand list or unknown handler
are to be removed.
.AP Tcl_Obj **listObjPtr out
Pointer to a variable into which to write the current list of formal
pre-subcommand parameters, the defined list of subcommands or the current
unknown handler prefix.
.AP Tcl_Namespace **namespacePtrPtr out

Changes to doc/FileSystem.3.

578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
If an error occurs while opening the channel, \fBTcl_FSOpenFileChannel\fR
returns NULL and records a POSIX error code that can be
retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, \fBTcl_FSOpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR, described below.
If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.
.PP
\fBTcl_FSGetCwd\fR replaces the library version of \fBgetcwd\fR.
.PP
It returns the Tcl library's current working directory. This may be







|







578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
If an error occurs while opening the channel, \fBTcl_FSOpenFileChannel\fR
returns NULL and records a POSIX error code that can be
retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, \fBTcl_FSOpenFileChannel\fR
leaves an error message in \fIinterp\fR's result after any error.
.PP
The newly created channel is not registered in the supplied interpreter; to
register it, use \fBTcl_RegisterChannel\fR.
If one of the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it as a
replacement for the standard channel.
.PP
\fBTcl_FSGetCwd\fR replaces the library version of \fBgetcwd\fR.
.PP
It returns the Tcl library's current working directory. This may be
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
and returns a Tcl list object containing each segment of that path as
an element.
It returns a list object with a reference count of zero. If the
passed in \fIlenPtr\fR is non-NULL, the variable it points to will be
updated to contain the number of elements in the returned list.
.PP
\fBTcl_FSEqualPaths\fR tests whether the two paths given represent the same
filesystem object
.PP
It returns 1 if the paths are equal, and 0 if they are different. If
either path is NULL, 0 is always returned.
.PP
\fBTcl_FSGetNormalizedPath\fR this important function attempts to extract
from the given Tcl_Obj a unique normalized path representation, whose
string value can be used as a unique identifier for the file.
.PP







|
<







645
646
647
648
649
650
651
652

653
654
655
656
657
658
659
and returns a Tcl list object containing each segment of that path as
an element.
It returns a list object with a reference count of zero. If the
passed in \fIlenPtr\fR is non-NULL, the variable it points to will be
updated to contain the number of elements in the returned list.
.PP
\fBTcl_FSEqualPaths\fR tests whether the two paths given represent the same
filesystem object.

It returns 1 if the paths are equal, and 0 if they are different. If
either path is NULL, 0 is always returned.
.PP
\fBTcl_FSGetNormalizedPath\fR this important function attempts to extract
from the given Tcl_Obj a unique normalized path representation, whose
string value can be used as a unique identifier for the file.
.PP
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
The \fIversion\fR field should be set to \fBTCL_FILESYSTEM_VERSION_1\fR.
.SS PATHINFILESYSTEMPROC
.PP
The \fIpathInFilesystemProc\fR field contains the address of a function
which is called to determine whether a given path object belongs to this
filesystem or not. Tcl will only call the rest of the filesystem
functions with a path for which this function has returned \fBTCL_OK\fR.
If the path does not belong, -1 should be returned (the behaviour of Tcl
for any other return value is not defined). If \fBTCL_OK\fR is returned,
then the optional \fIclientDataPtr\fR output parameter can be used to
return an internal (filesystem specific) representation of the path,
which will be cached inside the path object, and may be retrieved
efficiently by the other filesystem functions. Tcl will simultaneously
cache the fact that this path belongs to this filesystem. Such caches
are invalidated when filesystem structures are added or removed from







|







1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
The \fIversion\fR field should be set to \fBTCL_FILESYSTEM_VERSION_1\fR.
.SS PATHINFILESYSTEMPROC
.PP
The \fIpathInFilesystemProc\fR field contains the address of a function
which is called to determine whether a given path object belongs to this
filesystem or not. Tcl will only call the rest of the filesystem
functions with a path for which this function has returned \fBTCL_OK\fR.
If the path does not belong, -1 should be returned (the behavior of Tcl
for any other return value is not defined). If \fBTCL_OK\fR is returned,
then the optional \fIclientDataPtr\fR output parameter can be used to
return an internal (filesystem specific) representation of the path,
which will be cached inside the path object, and may be retrieved
efficiently by the other filesystem functions. Tcl will simultaneously
cache the fact that this path belongs to this filesystem. Such caches
are invalidated when filesystem structures are added or removed from
1215
1216
1217
1218
1219
1220
1221
1222
1223

1224
1225
1226
1227
1228
1229
1230
the POSIX flags O_RDONLY, O_WRONLY, etc. If an error occurs while
opening the channel, the \fBTcl_FSOpenFileChannelProc\fR returns NULL and
records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, the
\fBTcl_FSOpenFileChannelProc\fR leaves an error message in \fIinterp\fR's
result after any error.
.PP
The newly created channel is not registered in the supplied
interpreter; to register it, use \fBTcl_RegisterChannel\fR. If one of

the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it
as a replacement for the standard channel.
.SS MATCHINDIRECTORYPROC
.PP
Function to process a \fBTcl_FSMatchInDirectory\fR call. If not
implemented, then glob and recursive copy functionality will be lacking







|
|
>







1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
the POSIX flags O_RDONLY, O_WRONLY, etc. If an error occurs while
opening the channel, the \fBTcl_FSOpenFileChannelProc\fR returns NULL and
records a POSIX error code that can be retrieved with \fBTcl_GetErrno\fR.
In addition, if \fIinterp\fR is non-NULL, the
\fBTcl_FSOpenFileChannelProc\fR leaves an error message in \fIinterp\fR's
result after any error.
.PP
The newly created channel must not registered in the supplied
interpreter; that task is up to the caller of
\fBTcl_FSOpenFileChannel\fR (if necessary). If one of
the standard channels, \fBstdin\fR, \fBstdout\fR or \fBstderr\fR was
previously closed, the act of creating the new channel also assigns it
as a replacement for the standard channel.
.SS MATCHINDIRECTORYPROC
.PP
Function to process a \fBTcl_FSMatchInDirectory\fR call. If not
implemented, then glob and recursive copy functionality will be lacking

Changes to doc/FindExec.3.

43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
along with the \fBPATH\fR environment variable to find the
application's executable, if possible.  If it fails to find
the binary, then future calls to \fBinfo nameofexecutable\fR
will return an empty string.
.PP
On Windows platforms this procedure is typically invoked as the very
first thing in the application's main program as well; Its \fIargv[0]\fR
argument is only used to indicate wheter the executable has a stderr
channel (any non-null value) or not (the value null). If \fBTcl_SetPanicProc\fR
is never called and no debugger is running, this determines whether
the panic message is sent to stderr or to a standard system dialog.
.PP
\fBTcl_GetNameOfExecutable\fR simply returns a pointer to the
internal full path name of the executable file as computed by
\fBTcl_FindExecutable\fR.  This procedure call is the C API







|







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
along with the \fBPATH\fR environment variable to find the
application's executable, if possible.  If it fails to find
the binary, then future calls to \fBinfo nameofexecutable\fR
will return an empty string.
.PP
On Windows platforms this procedure is typically invoked as the very
first thing in the application's main program as well; Its \fIargv[0]\fR
argument is only used to indicate whether the executable has a stderr
channel (any non-null value) or not (the value null). If \fBTcl_SetPanicProc\fR
is never called and no debugger is running, this determines whether
the panic message is sent to stderr or to a standard system dialog.
.PP
\fBTcl_GetNameOfExecutable\fR simply returns a pointer to the
internal full path name of the executable file as computed by
\fBTcl_FindExecutable\fR.  This procedure call is the C API

Changes to doc/GetStdChan.3.

73
74
75
76
77
78
79
80
81
82
83
84
85
86
\fBTcl_Close\fR on the channel, then the next call to \fBTcl_CreateChannel\fR
will automatically set the standard channel with the newly created channel.  If
more than one standard channel is NULL, then the standard channels will be
assigned starting with standard input, followed by standard output, with
standard error being last.
.PP
See \fBTcl_StandardChannels\fR for a general treatise about standard
channels and the behaviour of the Tcl library with regard to them.

.SH "SEE ALSO"
Tcl_Close(3), Tcl_CreateChannel(3), Tcl_Main(3), tclsh(1)

.SH KEYWORDS
standard channel, standard input, standard output, standard error







|






73
74
75
76
77
78
79
80
81
82
83
84
85
86
\fBTcl_Close\fR on the channel, then the next call to \fBTcl_CreateChannel\fR
will automatically set the standard channel with the newly created channel.  If
more than one standard channel is NULL, then the standard channels will be
assigned starting with standard input, followed by standard output, with
standard error being last.
.PP
See \fBTcl_StandardChannels\fR for a general treatise about standard
channels and the behavior of the Tcl library with regard to them.

.SH "SEE ALSO"
Tcl_Close(3), Tcl_CreateChannel(3), Tcl_Main(3), tclsh(1)

.SH KEYWORDS
standard channel, standard input, standard output, standard error

Changes to doc/GetTime.3.

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
        ClientData \fIclientData\fR);
typedef void \fBTcl_ScaleTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        ClientData \fIclientData\fR);
.CE
.PP
The \fItimebuf\fR fields contain the time to manipulate, and the
\fIclientData\fR fields contain a pointer supplied at the time the
handler functions were registered.
.PP
Any handler pair specified has to return data which is consistent
between them. In other words, setting one handler of the pair to
something assuming a 10-times slowdown, and the other handler of the
pair to something assuming a two-times slowdown is wrong and not
allowed.
.PP
The set handler functions are allowed to run the delivered time
backwards, however this should be avoided. We have to allow it as the
native time can run backwards as the user can fiddle with the system
time one way or other. Note that the insertion of the hooks will not
change the behaviour of the Tcl core with regard to this situation,
i.e. the existing behaviour is retained.
.SH "SEE ALSO"
clock(n)
.SH KEYWORDS
date, time







|
|

|
|
|
|
<

|
|
|
|
<
|




86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102
103
104

105
106
107
108
109
        ClientData \fIclientData\fR);
typedef void \fBTcl_ScaleTimeProc\fR(
        Tcl_Time *\fItimebuf\fR,
        ClientData \fIclientData\fR);
.CE
.PP
The \fItimebuf\fR fields contain the time to manipulate, and the
\fIclientData\fR fields contain a pointer supplied at the time the handler
functions were registered.
.PP
Any handler pair specified has to return data which is consistent between
them. In other words, setting one handler of the pair to something assuming a
10-times slowdown, and the other handler of the pair to something assuming a
two-times slowdown is wrong and not allowed.

.PP
The set handler functions are allowed to run the delivered time backwards,
however this should be avoided. We have to allow it as the native time can run
backwards as the user can fiddle with the system time one way or other. Note
that the insertion of the hooks will not change the behavior of the Tcl core

with regard to this situation, i.e. the existing behavior is retained.
.SH "SEE ALSO"
clock(n)
.SH KEYWORDS
date, time

Changes to doc/Hash.3.

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
\fBTcl_InitHashTable\fR, this must have been initialized by
previous call to \fBTcl_InitHashTable\fR).
.AP int keyType in
Kind of keys to use for new hash table.  Must be either
\fBTCL_STRING_KEYS\fR, \fBTCL_ONE_WORD_KEYS\fR, \fBTCL_CUSTOM_TYPE_KEYS\fR,
\fBTCL_CUSTOM_PTR_KEYS\fR, or an integer value greater than 1.
.AP Tcl_HashKeyType *typePtr in
Address of structure which defines the behaviour of the hash table.
.AP "const void" *key in
Key to use for probe into table.  Exact form depends on
\fIkeyType\fR used to create table.
.AP int *newPtr out
The word at \fI*newPtr\fR is set to 1 if a new entry was created
and 0 if there was already an entry for \fIkey\fR.
.AP Tcl_HashEntry *entryPtr in







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
\fBTcl_InitHashTable\fR, this must have been initialized by
previous call to \fBTcl_InitHashTable\fR).
.AP int keyType in
Kind of keys to use for new hash table.  Must be either
\fBTCL_STRING_KEYS\fR, \fBTCL_ONE_WORD_KEYS\fR, \fBTCL_CUSTOM_TYPE_KEYS\fR,
\fBTCL_CUSTOM_PTR_KEYS\fR, or an integer value greater than 1.
.AP Tcl_HashKeyType *typePtr in
Address of structure which defines the behavior of the hash table.
.AP "const void" *key in
Key to use for probe into table.  Exact form depends on
\fIkeyType\fR used to create table.
.AP int *newPtr out
The word at \fI*newPtr\fR is set to 1 if a new entry was created
and 0 if there was already an entry for \fIkey\fR.
.AP Tcl_HashEntry *entryPtr in

Changes to doc/InitStubs.3.

59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Call \fBTcl_InitStubs\fR in the extension before calling any other
Tcl functions.
.IP 2) 5
Define the \fBUSE_TCL_STUBS\fR symbol.  Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library.  On Unix platforms, the library name is
\fIlibtclstub8.1.a\fR; on Windows platforms, the library name is
\fItclstub81.lib\fR.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
with the Tk stubs libraries.  See the \fBTk_InitStubs\fR page for
more information.
.SH DESCRIPTION
\fBTcl_InitStubs\fR attempts to initialize the stub table pointers







|
|
|







59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
Call \fBTcl_InitStubs\fR in the extension before calling any other
Tcl functions.
.IP 2) 5
Define the \fBUSE_TCL_STUBS\fR symbol.  Typically, you would include the
\fB\-DUSE_TCL_STUBS\fR flag when compiling the extension.
.IP 3) 5
Link the extension with the Tcl stubs library instead of the standard
Tcl library.  For example, to use the Tcl 8.1 ABI on Unix platforms,
the library name is \fIlibtclstub8.1.a\fR; on Windows platforms, the
library name is \fItclstub81.lib\fR.
.PP
If the extension also requires the Tk API, it must also call
\fBTk_InitStubs\fR to initialize the Tk stubs interface and link
with the Tk stubs libraries.  See the \fBTk_InitStubs\fR page for
more information.
.SH DESCRIPTION
\fBTcl_InitStubs\fR attempts to initialize the stub table pointers

Changes to doc/Notifier.3.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" 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.
'\" 
.so man.macros
.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode \- the event queue and notifier interfaces
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fR)
.sp











|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
'\"
'\" Copyright (c) 1998-1999 Scriptics Corporation
'\" 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.
'\" 
.so man.macros
.TH Notifier 3 8.1 Tcl "Tcl Library Procedures"
.BS
.SH NAME
Tcl_CreateEventSource, Tcl_DeleteEventSource, Tcl_SetMaxBlockTime, Tcl_QueueEvent, Tcl_ThreadQueueEvent, Tcl_ThreadAlert, Tcl_GetCurrentThread, Tcl_DeleteEvents, Tcl_InitNotifier, Tcl_FinalizeNotifier, Tcl_WaitForEvent, Tcl_AlertNotifier, Tcl_SetTimer, Tcl_ServiceAll, Tcl_ServiceEvent, Tcl_GetServiceMode, Tcl_SetServiceMode, Tcl_ServiceModeHook, Tcl_SetNotifier \- the event queue and notifier interfaces
.SH SYNOPSIS
.nf
\fB#include <tcl.h>\fR
.sp
void
\fBTcl_CreateEventSource\fR(\fIsetupProc, checkProc, clientData\fR)
.sp

Changes to doc/OpenFileChnl.3.

328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
This allows code executing outside of any interpreter to safely hold a
reference to a channel that is also registered in a Tcl interpreter.
.PP
This procedure interacts with the code managing the standard
channels. If no standard channels were initialized before the first
call to \fBTcl_RegisterChannel\fR, they will get initialized by that
call. See \fBTcl_StandardChannels\fR for a general treatise about
standard channels and the behaviour of the Tcl library with regard to
them.
.SH TCL_UNREGISTERCHANNEL
.PP
\fBTcl_UnregisterChannel\fR removes a channel from the set of channels
accessible in \fIinterp\fR. After this call, Tcl programs will no longer be
able to use the channel's name to refer to the channel in that interpreter.
If this operation removed the last registration of the channel in any







|







328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
This allows code executing outside of any interpreter to safely hold a
reference to a channel that is also registered in a Tcl interpreter.
.PP
This procedure interacts with the code managing the standard
channels. If no standard channels were initialized before the first
call to \fBTcl_RegisterChannel\fR, they will get initialized by that
call. See \fBTcl_StandardChannels\fR for a general treatise about
standard channels and the behavior of the Tcl library with regard to
them.
.SH TCL_UNREGISTERCHANNEL
.PP
\fBTcl_UnregisterChannel\fR removes a channel from the set of channels
accessible in \fIinterp\fR. After this call, Tcl programs will no longer be
able to use the channel's name to refer to the channel in that interpreter.
If this operation removed the last registration of the channel in any

Changes to doc/RegConfig.3.

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
.PP
When called \fBTcl_RegisterConfig\fR will
.IP (1)
create a namespace having the provided \fIpkgName\fR, if not yet
existing.
.IP (2)
create the command \fBpkgconfig\fR in that namespace and link it to
the provided information so that the keys from _configuration_ and
their associated values can be retrieved through calls to
\fBpkgconfig\fR.
.PP
The command \fBpkgconfig\fR will provide two subcommands, \fBlist\fR
and \fBget\fR:
.RS
.TP







|







76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
.PP
When called \fBTcl_RegisterConfig\fR will
.IP (1)
create a namespace having the provided \fIpkgName\fR, if not yet
existing.
.IP (2)
create the command \fBpkgconfig\fR in that namespace and link it to
the provided information so that the keys from \fIconfiguration\fR and
their associated values can be retrieved through calls to
\fBpkgconfig\fR.
.PP
The command \fBpkgconfig\fR will provide two subcommands, \fBlist\fR
and \fBget\fR:
.RS
.TP

Changes to doc/SetChanErr.3.

47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
channel options. All other functions are restricted to POSIX error codes.
.PP
The functions described here overcome this limitation. Channel drivers are
allowed to use \fBTcl_SetChannelError\fR and \fBTcl_SetChannelErrorInterp\fR
to place arbitrary error messages in \fBbypass areas\fR defined for channels
and interpreters. And the generic I/O layer uses \fBTcl_GetChannelError\fR and
\fBTcl_GetChannelErrorInterp\fR to look for messages in the bypass areas and
arrange for their return as errors. The posix error codes set by a driver are
used now if and only if no messages are present.
.PP
\fBTcl_SetChannelError\fR stores error information in the bypass area of the
specified channel. The number of references to the \fBmsg\fR object goes up by
one. Previously stored information will be discarded, by releasing the
reference held by the channel. The channel reference must not be NULL.
.PP







|







47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
channel options. All other functions are restricted to POSIX error codes.
.PP
The functions described here overcome this limitation. Channel drivers are
allowed to use \fBTcl_SetChannelError\fR and \fBTcl_SetChannelErrorInterp\fR
to place arbitrary error messages in \fBbypass areas\fR defined for channels
and interpreters. And the generic I/O layer uses \fBTcl_GetChannelError\fR and
\fBTcl_GetChannelErrorInterp\fR to look for messages in the bypass areas and
arrange for their return as errors. The POSIX error codes set by a driver are
used now if and only if no messages are present.
.PP
\fBTcl_SetChannelError\fR stores error information in the bypass area of the
specified channel. The number of references to the \fBmsg\fR object goes up by
one. Previously stored information will be discarded, by releasing the
reference held by the channel. The channel reference must not be NULL.
.PP

Changes to doc/SplitPath.3.

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
.AP Tcl_DString *resultPtr in/out
A pointer to an initialized \fBTcl_DString\fR to which the result of
\fBTcl_JoinPath\fR will be appended.
.BE

.SH DESCRIPTION
.PP
These procedures have been superceded by the objectified procedures in
the \fBFileSystem\fR man page, which are more efficient.
.PP
These procedures may be used to disassemble and reassemble file
paths in a platform independent manner: they provide C-level access to
the same functionality as the \fBfile split\fR, \fBfile join\fR, and
\fBfile pathtype\fR commands.
.PP







|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
.AP Tcl_DString *resultPtr in/out
A pointer to an initialized \fBTcl_DString\fR to which the result of
\fBTcl_JoinPath\fR will be appended.
.BE

.SH DESCRIPTION
.PP
These procedures have been superseded by the objectified procedures in
the \fBFileSystem\fR man page, which are more efficient.
.PP
These procedures may be used to disassemble and reassemble file
paths in a platform independent manner: they provide C-level access to
the same functionality as the \fBfile split\fR, \fBfile join\fR, and
\fBfile pathtype\fR commands.
.PP

Changes to doc/StringObj.3.

121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
The object to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the length of an object's string representation.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialised using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP int limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."







|







121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
The object to append to \fIobjPtr\fR in \fBTcl_AppendObjToObj\fR.
.AP int *lengthPtr out
If non-NULL, the location where \fBTcl_GetStringFromObj\fR will store
the length of an object's string representation.
.AP "const char" *string in
Null-terminated string value to append to \fIobjPtr\fR.
.AP va_list argList in
An argument list which must have been initialized using
\fBva_start\fR, and cleared using \fBva_end\fR.
.AP int limit in
Maximum number of bytes to be appended.
.AP "const char" *ellipsis in
Suffix to append when the limit leads to string truncation.
If NULL is passed then the suffix
.QW "..."
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
object's new string representation.
.PP
\fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by
\fIunicode\fR and \fInumChars\fR to the object specified by
\fIobjPtr\fR.  If the object has an invalid Unicode representation,
then \fIunicode\fR is converted to the UTF format and appended to the
object's string representation.  Appends are optimized to handle
repeated appends relatively efficiently (it overallocates the string
or Unicode space to avoid repeated reallocations and copies of
object's string value).
.PP
\fBTcl_AppendObjToObj\fR is similar to \fBTcl_AppendToObj\fR, but it
appends the string or Unicode value (whichever exists and is best
suited to be appended to \fIobjPtr\fR) of \fIappendObjPtr\fR to
\fIobjPtr\fR.







|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
object's new string representation.
.PP
\fBTcl_AppendUnicodeToObj\fR appends the Unicode string given by
\fIunicode\fR and \fInumChars\fR to the object specified by
\fIobjPtr\fR.  If the object has an invalid Unicode representation,
then \fIunicode\fR is converted to the UTF format and appended to the
object's string representation.  Appends are optimized to handle
repeated appends relatively efficiently (it over-allocates the string
or Unicode space to avoid repeated reallocations and copies of
object's string value).
.PP
\fBTcl_AppendObjToObj\fR is similar to \fBTcl_AppendToObj\fR, but it
appends the string or Unicode value (whichever exists and is best
suited to be appended to \fIobjPtr\fR) of \fIappendObjPtr\fR to
\fIobjPtr\fR.

Changes to doc/Tcl.n.

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
inserted.  The upper bits of the Unicode character will be 0.
.TP 7
\e\fBU\fIhhhhhhhh\fR 
.
The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
twentiy-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+0000..U+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.PP
The range U+010000..U+10FFFD is reserved for the future.
.PP
Backslash substitution is not performed on words enclosed in braces,







|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
sixteen-bit hexadecimal value for the Unicode character that will be
inserted.  The upper bits of the Unicode character will be 0.
.TP 7
\e\fBU\fIhhhhhhhh\fR 
.
The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
twenty-one-bit hexadecimal value for the Unicode character that will be
inserted, in the range U+0000..U+10FFFF.  The parser will stop just
before this range overflows, or when the maximum of eight digits
is reached.  The upper bits of the Unicode character will be 0.
.PP
The range U+010000..U+10FFFD is reserved for the future.
.PP
Backslash substitution is not performed on words enclosed in braces,

Changes to doc/Thread.3.

66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP ClientData clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behaviour of
the new thread.
.AP int *result out
The referred storage is used to place the exit code of the thread
waited upon into it.
.BE
.SH INTRODUCTION
Beginning with the 8.1 release, the Tcl core is thread safe, which
allows you to incorporate Tcl into multithreaded applications without
customizing the Tcl core.  To enable Tcl multithreading support,
you must include the \fB\-\|\-enable-threads\fR option to \fBconfigure\fR
when you configure and compile your Tcl core.
.PP
An important constraint of the Tcl threads implementation is that
\fIonly the thread that created a Tcl interpreter can use that
interpreter\fR.  In other words, multiple threads can not access
the same Tcl interpreter.  (However, a single thread can safely create
and use multiple interpreters.)
.SH DESCRIPTION
Tcl provides \fBTcl_CreateThread\fR for creating threads. The
caller can determine the size of the stack given to the new thread and
modify the behaviour through the supplied \fIflags\fR. The value
\fBTCL_THREAD_STACK_DEFAULT\fR for the \fIstackSize\fR indicates that
the default size as specified by the operating system is to be used
for the new thread. As for the flags, currently only the values
\fBTCL_THREAD_NOFLAGS\fR and \fBTCL_THREAD_JOINABLE\fR are defined. The
first of them invokes the default behaviour with no
specialties. Using the second value marks the new thread as
\fIjoinable\fR. This means that another thread can wait for the such
marked thread to exit and join it.
.PP
Restrictions: On some UNIX systems the pthread-library does not
contain the functionality to specify the stack size of a thread. The
specified value for the stack size is ignored on these systems.
Windows currently does not support joinable threads. This
flag value is therefore ignored on this platform.
.PP







|




















|




|
|
|
|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
This procedure will act as the \fBmain()\fR of the newly created
thread. The specified \fIclientData\fR will be its sole argument.
.AP ClientData clientData in
Arbitrary information. Passed as sole argument to the \fIproc\fR.
.AP int stackSize in
The size of the stack given to the new thread.
.AP int flags in
Bitmask containing flags allowing the caller to modify behavior of
the new thread.
.AP int *result out
The referred storage is used to place the exit code of the thread
waited upon into it.
.BE
.SH INTRODUCTION
Beginning with the 8.1 release, the Tcl core is thread safe, which
allows you to incorporate Tcl into multithreaded applications without
customizing the Tcl core.  To enable Tcl multithreading support,
you must include the \fB\-\|\-enable-threads\fR option to \fBconfigure\fR
when you configure and compile your Tcl core.
.PP
An important constraint of the Tcl threads implementation is that
\fIonly the thread that created a Tcl interpreter can use that
interpreter\fR.  In other words, multiple threads can not access
the same Tcl interpreter.  (However, a single thread can safely create
and use multiple interpreters.)
.SH DESCRIPTION
Tcl provides \fBTcl_CreateThread\fR for creating threads. The
caller can determine the size of the stack given to the new thread and
modify the behavior through the supplied \fIflags\fR. The value
\fBTCL_THREAD_STACK_DEFAULT\fR for the \fIstackSize\fR indicates that
the default size as specified by the operating system is to be used
for the new thread. As for the flags, currently only the values
\fBTCL_THREAD_NOFLAGS\fR and \fBTCL_THREAD_JOINABLE\fR are defined. The
first of them invokes the default behavior with no special settings.
Using the second value marks the new thread as \fIjoinable\fR. This
means that another thread can wait for the such marked thread to exit
and join it.
.PP
Restrictions: On some UNIX systems the pthread-library does not
contain the functionality to specify the stack size of a thread. The
specified value for the stack size is ignored on these systems.
Windows currently does not support joinable threads. This
flag value is therefore ignored on this platform.
.PP

Changes to doc/binary.n.

88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them.
.RE
.TP
\fBuuencode\fR
.
The \fBuuencode\fR binary encoding used to be common for transfer of data
between Unix systems and on USENET, but is less common these days, having been
largely superceded by the \fBbase64\fR binary encoding.
.RS
.PP
During encoding, the following options are supported:
'\" This is wrong! The uuencode format had more complexity than this!
.TP
\fB\-maxlen \fIlength\fR
.







|







88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
Instructs the decoder to throw an error if it encounters whitespace characters. Otherwise it ignores them.
.RE
.TP
\fBuuencode\fR
.
The \fBuuencode\fR binary encoding used to be common for transfer of data
between Unix systems and on USENET, but is less common these days, having been
largely superseded by the \fBbase64\fR binary encoding.
.RS
.PP
During encoding, the following options are supported:
'\" This is wrong! The uuencode format had more complexity than this!
.TP
\fB\-maxlen \fIlength\fR
.
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
formatted.  The type character specifies how the value is to be
formatted.  The \fIcount\fR typically indicates how many items of the
specified type are taken from the value.  If present, the \fIcount\fR
is a non-negative decimal integer or \fB*\fR, which normally indicates
that all of the items in the value are to be used.  If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated. The flag character
is ignored for for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE
.PP







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
formatted.  The type character specifies how the value is to be
formatted.  The \fIcount\fR typically indicates how many items of the
specified type are taken from the value.  If present, the \fIcount\fR
is a non-negative decimal integer or \fB*\fR, which normally indicates
that all of the items in the value are to be used.  If the number of
arguments does not match the number of fields in the format string
that consume arguments, then an error is generated. The flag character
is ignored for \fBbinary format\fR.
.PP
Here is a small example to clarify the relation between the field
specifiers and the arguments:
.CS
\fBbinary format\fR d3d {1.0 2.0 3.0 4.0} 0.1
.CE
.PP

Changes to doc/catch.n.

73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
unwinding the stack. The token may be
.QW \fBCALL\fR ,
in which case the parameter is a list made of the proc name and arguments at
the corresponding level; or it may be
.QW \fBUP\fR ,
in which case the parameter is
the relative level (as in \fBuplevel\fR) of the previous \fBCALL\fR. The
salient differences wrt \fB\-errorinfo\fR are that:
.IP [1]
it is a machine-readable form that is amenable to processing with
[\fBforeach\fR {tok prm} ...],
.IP [2]
it contains the true (substituted) values passed to the functions, instead of
the static text of the calling sites, and
.IP [3]







|







73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
unwinding the stack. The token may be
.QW \fBCALL\fR ,
in which case the parameter is a list made of the proc name and arguments at
the corresponding level; or it may be
.QW \fBUP\fR ,
in which case the parameter is
the relative level (as in \fBuplevel\fR) of the previous \fBCALL\fR. The
salient differences with respect to \fB\-errorinfo\fR are that:
.IP [1]
it is a machine-readable form that is amenable to processing with
[\fBforeach\fR {tok prm} ...],
.IP [2]
it contains the true (substituted) values passed to the functions, instead of
the static text of the calling sites, and
.IP [3]

Changes to doc/chan.n.

53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
buffered input is discarded (only if the channel is ceasing to be readable),
the underlying operating system resource is closed and \fIchannelId\fR becomes
unavailable for future use (both only if the channel is being completely
closed).
.PP
If the channel is blocking and the channel is ceasing to be writable, the
command does not return until all output is flushed.  If the channel is
nonblocking and there is unflushed output, the channel remains open and the
command returns immediately; output will be flushed in the background and the
channel will be closed when all the flushing is complete.
.PP
If \fIchannelId\fR is a blocking channel for a command pipeline then
\fBchan close\fR waits for the child processes to complete.
.PP
If the channel is shared between interpreters, then \fBchan close\fR







|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
buffered input is discarded (only if the channel is ceasing to be readable),
the underlying operating system resource is closed and \fIchannelId\fR becomes
unavailable for future use (both only if the channel is being completely
closed).
.PP
If the channel is blocking and the channel is ceasing to be writable, the
command does not return until all output is flushed.  If the channel is
non-blocking and there is unflushed output, the channel remains open and the
command returns immediately; output will be flushed in the background and the
channel will be closed when all the flushing is complete.
.PP
If \fIchannelId\fR is a blocking channel for a command pipeline then
\fBchan close\fR waits for the child processes to complete.
.PP
If the channel is shared between interpreters, then \fBchan close\fR
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
then the command returns the current value of the given option.  If
one or more pairs of \fIoptionName\fR and \fIvalue\fR are supplied,
the command sets each of the named options to the corresponding
\fIvalue\fR; in this case the return value is an empty string.
.PP
The options described below are supported for all channels. In
addition, each channel type may add options that only it supports. See
the manual entry for the command that creates each type of channels
for the options that that specific type of channel supports. For
example, see the manual entry for the \fBsocket\fR command for additional
options for sockets, and the \fBopen\fR command for additional options for
serial devices.
.TP
\fB\-blocking\fR \fIboolean\fR
.
The \fB\-blocking\fR option determines whether I/O operations on the
channel can cause the process to block indefinitely.  The value of the
option must be a proper boolean value.  Channels are normally in
blocking mode; if a channel is placed into nonblocking mode it will
affect the operation of the \fBchan gets\fR, \fBchan read\fR, \fBchan
puts\fR, \fBchan flush\fR, and \fBchan close\fR commands; see the
documentation for those commands for details.  For nonblocking mode to
work correctly, the application must be using the Tcl event loop
(e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR
command).
.TP
\fB\-buffering\fR \fInewValue\fR
.
If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output







|
|









|


|







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
then the command returns the current value of the given option.  If
one or more pairs of \fIoptionName\fR and \fIvalue\fR are supplied,
the command sets each of the named options to the corresponding
\fIvalue\fR; in this case the return value is an empty string.
.PP
The options described below are supported for all channels. In
addition, each channel type may add options that only it supports. See
the manual entry for the command that creates each type of channel
for the options supported by that specific type of channel. For
example, see the manual entry for the \fBsocket\fR command for additional
options for sockets, and the \fBopen\fR command for additional options for
serial devices.
.TP
\fB\-blocking\fR \fIboolean\fR
.
The \fB\-blocking\fR option determines whether I/O operations on the
channel can cause the process to block indefinitely.  The value of the
option must be a proper boolean value.  Channels are normally in
blocking mode; if a channel is placed into non-blocking mode it will
affect the operation of the \fBchan gets\fR, \fBchan read\fR, \fBchan
puts\fR, \fBchan flush\fR, and \fBchan close\fR commands; see the
documentation for those commands for details.  For non-blocking mode to
work correctly, the application must be using the Tcl event loop
(e.g. by calling \fBTcl_DoOneEvent\fR or invoking the \fBvwait\fR
command).
.TP
\fB\-buffering\fR \fInewValue\fR
.
If \fInewValue\fR is \fBfull\fR then the I/O system will buffer output
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
between these threads. In other words, we can provide a way for
regular stream communication between threads instead of having to send
commands.
.PP
When a thread or interpreter is deleted, all channels created with
this subcommand and using this thread/interpreter as their computing
base are deleted as well, in all interpreters they have been shared
with or moved into, and in whatever thread they have been transfered
to. While this pulls the rug out under the other thread(s) and/or
interpreter(s), this cannot be avoided. Trying to use such a channel
will cause the generation of a regular error about unknown channel
handles.
.PP
This subcommand is \fBsafe\fR and made accessible to safe
interpreters.  While it arranges for the execution of arbitrary Tcl







|







395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
between these threads. In other words, we can provide a way for
regular stream communication between threads instead of having to send
commands.
.PP
When a thread or interpreter is deleted, all channels created with
this subcommand and using this thread/interpreter as their computing
base are deleted as well, in all interpreters they have been shared
with or moved into, and in whatever thread they have been transferred
to. While this pulls the rug out under the other thread(s) and/or
interpreter(s), this cannot be avoided. Trying to use such a channel
will cause the generation of a regular error about unknown channel
handles.
.PP
This subcommand is \fBsafe\fR and made accessible to safe
interpreters.  While it arranges for the execution of arbitrary Tcl
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
.PP
A channel is considered to be readable if there is unread data
available on the underlying device.  A channel is also considered to
be readable if there is unread data in an input buffer, except in the
special case where the most recent attempt to read from the channel
was a \fBchan gets\fR call that could not find a complete line in the
input buffer.  This feature allows a file to be read a line at a time
in nonblocking mode using events.  A channel is also considered to be
readable if an end of file or error condition is present on the
underlying file or device.  It is important for \fIscript\fR to check
for these conditions and handle them appropriately; for example, if
there is no special check for end of file, an infinite loop may occur
where \fIscript\fR reads no data, returns, and is immediately invoked
again.
.PP
A channel is considered to be writable if at least one byte of data
can be written to the underlying file or device without blocking, or
if an error condition is present on the underlying file or device.
Note that client sockets opened in asynchronous mode become writable
when they become connected or if the connection fails.
.PP
Event-driven I/O works best for channels that have been placed into
nonblocking mode with the \fBchan configure\fR command.  In blocking
mode, a \fBchan puts\fR command may block if you give it more data
than the underlying file or device can accept, and a \fBchan gets\fR
or \fBchan read\fR command will block if you attempt to read more data
than is ready; no events will be processed while the commands block.
In nonblocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan
gets\fR never block.
.PP
The script for a file event is executed at global level (outside the
context of any Tcl procedure) in the interpreter in which the \fBchan
event\fR command was invoked.  If an error occurs while executing the
script then the command registered with \fBinterp bgerror\fR is used
to report the error.  In addition, the file event handler is deleted
if it ever returns an error; this is done in order to prevent infinite
loops due to buggy handlers.
.RE
.TP
\fBchan flush \fIchannelId\fR
.
Ensures that all pending output for the channel called \fIchannelId\fR
is written.
.RS
.PP
If the channel is in blocking mode the command does not return until
all the buffered output has been flushed to the channel. If the
channel is in nonblocking mode, the command may return before all
buffered output has been flushed; the remainder will be flushed in the
background as fast as the underlying file or device is able to absorb
it.
.RE
.TP
\fBchan gets \fIchannelId\fR ?\fIvarName\fR?
.







|














|




|



















|







449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
.PP
A channel is considered to be readable if there is unread data
available on the underlying device.  A channel is also considered to
be readable if there is unread data in an input buffer, except in the
special case where the most recent attempt to read from the channel
was a \fBchan gets\fR call that could not find a complete line in the
input buffer.  This feature allows a file to be read a line at a time
in non-blocking mode using events.  A channel is also considered to be
readable if an end of file or error condition is present on the
underlying file or device.  It is important for \fIscript\fR to check
for these conditions and handle them appropriately; for example, if
there is no special check for end of file, an infinite loop may occur
where \fIscript\fR reads no data, returns, and is immediately invoked
again.
.PP
A channel is considered to be writable if at least one byte of data
can be written to the underlying file or device without blocking, or
if an error condition is present on the underlying file or device.
Note that client sockets opened in asynchronous mode become writable
when they become connected or if the connection fails.
.PP
Event-driven I/O works best for channels that have been placed into
non-blocking mode with the \fBchan configure\fR command.  In blocking
mode, a \fBchan puts\fR command may block if you give it more data
than the underlying file or device can accept, and a \fBchan gets\fR
or \fBchan read\fR command will block if you attempt to read more data
than is ready; no events will be processed while the commands block.
In non-blocking mode \fBchan puts\fR, \fBchan read\fR, and \fBchan
gets\fR never block.
.PP
The script for a file event is executed at global level (outside the
context of any Tcl procedure) in the interpreter in which the \fBchan
event\fR command was invoked.  If an error occurs while executing the
script then the command registered with \fBinterp bgerror\fR is used
to report the error.  In addition, the file event handler is deleted
if it ever returns an error; this is done in order to prevent infinite
loops due to buggy handlers.
.RE
.TP
\fBchan flush \fIchannelId\fR
.
Ensures that all pending output for the channel called \fIchannelId\fR
is written.
.RS
.PP
If the channel is in blocking mode the command does not return until
all the buffered output has been flushed to the channel. If the
channel is in non-blocking mode, the command may return before all
buffered output has been flushed; the remainder will be flushed in the
background as fast as the underlying file or device is able to absorb
it.
.RE
.TP
\fBchan gets \fIchannelId\fR ?\fIvarName\fR?
.
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
available is exhausted.
.RS
.PP
If an end-of-file occurs while part way through reading a line, the
partial line will be returned (or written into \fIvarName\fR). When
\fIvarName\fR is not specified, the end-of-file case can be
distinguished from an empty line using the \fBchan eof\fR command, and
the partial-line-but-nonblocking case can be distinguished with the
\fBchan blocked\fR command.
.RE
.TP
\fBchan names\fR ?\fIpattern\fR?
.
Produces a list of all channel names. If \fIpattern\fR is specified,
only those channel names that match it (according to the rules of







|







512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
available is exhausted.
.RS
.PP
If an end-of-file occurs while part way through reading a line, the
partial line will be returned (or written into \fIvarName\fR). When
\fIvarName\fR is not specified, the end-of-file case can be
distinguished from an empty line using the \fBchan eof\fR command, and
the partial-line-but-non-blocking case can be distinguished with the
\fBchan blocked\fR command.
.RE
.TP
\fBchan names\fR ?\fIpattern\fR?
.
Produces a list of all channel names. If \fIpattern\fR is specified,
only those channel names that match it (according to the rules of
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
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
682
683
684
685
puts\fR may not appear immediately on the output file or device; Tcl
will normally delay output until the buffer is full or the channel is
closed.  You can force output to appear immediately with the \fBchan
flush\fR command.
.PP
When the output buffer fills up, the \fBchan puts\fR command will
normally block until all the buffered data has been accepted for
output by the operating system.  If \fIchannelId\fR is in nonblocking
mode then the \fBchan puts\fR command will not block even if the
operating system cannot accept the data.  Instead, Tcl continues to
buffer the data and writes it in the background as fast as the
underlying file or device can accept it.  The application must use the
Tcl event loop for nonblocking output to work; otherwise Tcl never
finds out that the file or device is ready for more output data.  It
is possible for an arbitrarily large amount of data to be buffered for
a channel in nonblocking mode, which could consume a large amount of
memory.  To avoid wasting memory, nonblocking I/O should normally be
used in an event-driven fashion with the \fBchan event\fR command
(do not invoke \fBchan puts\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
.RE
.TP
\fBchan read \fIchannelId\fR ?\fInumChars\fR?
.TP
\fBchan read \fR?\fB\-nonewline\fR? \fIchannelId\fR
.
In the first form, the result will be the next \fInumChars\fR
characters read from the channel named \fIchannelId\fR; if
\fInumChars\fR is omitted, all characters up to the point when the
channel would signal a failure (whether an end-of-file, blocked or
other error condition) are read. In the second form (i.e. when
\fInumChars\fR has been omitted) the flag \fB\-nonewline\fR may be
given to indicate that any trailing newline in the string that has
been read should be trimmed.
.RS
.PP
If \fIchannelId\fR is in nonblocking mode, \fBchan read\fR may not
read as many characters as requested: once all available input has
been read, the command will return the data that is available rather
than blocking for more input.  If the channel is configured to use a
multi-byte encoding, then there may actually be some bytes remaining
in the internal buffers that do not form a complete character.  These
bytes will not be returned until a complete character is available or
end-of-file is reached.  The \fB\-nonewline\fR switch is ignored if
the command returns before reaching the end of the file.
.PP
\fBChan read\fR translates end-of-line sequences in the input into
newline characters according to the \fB\-translation\fR option for the
channel (see \fBchan configure\fR above for a discussion on the ways
in which \fBchan configure\fR will alter input).
.PP
When reading from a serial port, most applications should configure
the serial port channel to be nonblocking, like this:
.PP
.CS
\fBchan configure \fIchannelId \fB\-blocking \fI0\fR.
.CE
.PP
Then \fBchan read\fR behaves much like described above.  Note that
most serial ports are comparatively slow; it is entirely possible to







|




|


|
|



















|















|







626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
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
682
683
684
685
puts\fR may not appear immediately on the output file or device; Tcl
will normally delay output until the buffer is full or the channel is
closed.  You can force output to appear immediately with the \fBchan
flush\fR command.
.PP
When the output buffer fills up, the \fBchan puts\fR command will
normally block until all the buffered data has been accepted for
output by the operating system.  If \fIchannelId\fR is in non-blocking
mode then the \fBchan puts\fR command will not block even if the
operating system cannot accept the data.  Instead, Tcl continues to
buffer the data and writes it in the background as fast as the
underlying file or device can accept it.  The application must use the
Tcl event loop for non-blocking output to work; otherwise Tcl never
finds out that the file or device is ready for more output data.  It
is possible for an arbitrarily large amount of data to be buffered for
a channel in non-blocking mode, which could consume a large amount of
memory.  To avoid wasting memory, non-blocking I/O should normally be
used in an event-driven fashion with the \fBchan event\fR command
(do not invoke \fBchan puts\fR unless you have recently been notified
via a file event that the channel is ready for more output data).
.RE
.TP
\fBchan read \fIchannelId\fR ?\fInumChars\fR?
.TP
\fBchan read \fR?\fB\-nonewline\fR? \fIchannelId\fR
.
In the first form, the result will be the next \fInumChars\fR
characters read from the channel named \fIchannelId\fR; if
\fInumChars\fR is omitted, all characters up to the point when the
channel would signal a failure (whether an end-of-file, blocked or
other error condition) are read. In the second form (i.e. when
\fInumChars\fR has been omitted) the flag \fB\-nonewline\fR may be
given to indicate that any trailing newline in the string that has
been read should be trimmed.
.RS
.PP
If \fIchannelId\fR is in non-blocking mode, \fBchan read\fR may not
read as many characters as requested: once all available input has
been read, the command will return the data that is available rather
than blocking for more input.  If the channel is configured to use a
multi-byte encoding, then there may actually be some bytes remaining
in the internal buffers that do not form a complete character.  These
bytes will not be returned until a complete character is available or
end-of-file is reached.  The \fB\-nonewline\fR switch is ignored if
the command returns before reaching the end of the file.
.PP
\fBChan read\fR translates end-of-line sequences in the input into
newline characters according to the \fB\-translation\fR option for the
channel (see \fBchan configure\fR above for a discussion on the ways
in which \fBchan configure\fR will alter input).
.PP
When reading from a serial port, most applications should configure
the serial port channel to be non-blocking, like this:
.PP
.CS
\fBchan configure \fIchannelId \fB\-blocking \fI0\fR.
.CE
.PP
Then \fBchan read\fR behaves much like described above.  Note that
most serial ports are comparatively slow; it is entirely possible to
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
file or device.  A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
position after the end of file.
.PP
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
\fBChan seek\fR flushes all buffered output for the channel before the
command returns, even if the channel is in nonblocking mode.  It also
discards any buffered and unread input.  This command returns an empty
string.  An error occurs if this command is applied to channels whose
underlying file or device does not support seeking.
.PP
Note that \fIoffset\fR values are byte offsets, not character offsets.
Both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes,
not characters, unlike \fBchan read\fR.







|







724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
file or device.  A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
position after the end of file.
.PP
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
\fBChan seek\fR flushes all buffered output for the channel before the
command returns, even if the channel is in non-blocking mode.  It also
discards any buffered and unread input.  This command returns an empty
string.  An error occurs if this command is applied to channels whose
underlying file or device does not support seeking.
.PP
Note that \fIoffset\fR values are byte offsets, not character offsets.
Both \fBchan seek\fR and \fBchan tell\fR operate in terms of bytes,
not characters, unlike \fBchan read\fR.

Changes to doc/close.n.

19
20
21
22
23
24
25
26

27
28
29
30
31
32
33
Closes or half-closes the channel given by \fIchannelId\fR.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR),
the return value from an invocation of \fBopen\fR or \fBsocket\fR, or
the result of a channel creation command provided by a Tcl extension.
.PP
The single-argument form is a simple "full-close":

all buffered output is flushed to the channel's output device,
any buffered input is discarded, the underlying file or device is closed,
and \fIchannelId\fR becomes unavailable for use.
.PP
If the channel is blocking, the command does not return until all output
is flushed.
If the channel is nonblocking and there is unflushed output, the







|
>







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
Closes or half-closes the channel given by \fIchannelId\fR.
.PP
\fIChannelId\fR must be an identifier for an open channel such as a
Tcl standard channel (\fBstdin\fR, \fBstdout\fR, or \fBstderr\fR),
the return value from an invocation of \fBopen\fR or \fBsocket\fR, or
the result of a channel creation command provided by a Tcl extension.
.PP
The single-argument form is a simple
.QW "full-close" :
all buffered output is flushed to the channel's output device,
any buffered input is discarded, the underlying file or device is closed,
and \fIchannelId\fR becomes unavailable for use.
.PP
If the channel is blocking, the command does not return until all output
is flushed.
If the channel is nonblocking and there is unflushed output, the
52
53
54
55
56
57
58
59


60
61
62
63
64
65
66


67
68
69
70
71
72
73
74
75
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error, \fBclose\fR
generates an error (similar to the \fBexec\fR command.)
.PP
.VS 8.6
The two-argument form is a "half-close": given a bidirectional channel like a


socket or command pipeline and a (possibly abbreviated) direction, it closes
only the substream going in that direction. This means a shutdown() on a
socket, and a close() of one end of a pipe for a command pipeline. Then, the
Tcl-level channel data structure is either kept or freed depending on whether
the other direction is still open.
.PP
A single-argument close on an already half-closed bi-channel is defined to


just "finish the job. A half-close on an already closed half, or on a
wrong-sided unidirectional channel, raises an error.
.PP
In the case of a command pipeline, the child-reaping duty falls upon the
shoulders of the last close or half-close, which is thus allowed to report an
abnormal exit error.
.PP
Currently only sockets and command pipelines support half-close. A future
extension will allow reflected and stacked channels to do so.







|
>
>

|




|
>
>
|
|







53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
.PP
The command returns an empty string, and may generate an error if
an error occurs while flushing output.  If a command in a command
pipeline created with \fBopen\fR returns an error, \fBclose\fR
generates an error (similar to the \fBexec\fR command.)
.PP
.VS 8.6
The two-argument form is a
.QW "half-close" :
given a bidirectional channel like a
socket or command pipeline and a (possibly abbreviated) direction, it closes
only the sub-stream going in that direction. This means a shutdown() on a
socket, and a close() of one end of a pipe for a command pipeline. Then, the
Tcl-level channel data structure is either kept or freed depending on whether
the other direction is still open.
.PP
A single-argument close on an already half-closed bidirectional channel is
defined to just
.QW "finish the job" .
A half-close on an already closed half, or on a wrong-sided unidirectional
channel, raises an error.
.PP
In the case of a command pipeline, the child-reaping duty falls upon the
shoulders of the last close or half-close, which is thus allowed to report an
abnormal exit error.
.PP
Currently only sockets and command pipelines support half-close. A future
extension will allow reflected and stacked channels to do so.

Changes to doc/copy.n.

22
23
24
25
26
27
28
29








30





31
32
33
34
35
36
37
38
39
The \fBoo::copy\fR command creates a copy of an object or class. It takes the
name of the object or class to be copied, \fIsourceObject\fR, and optionally
the name of the object or class to create, \fItargetObject\fR, which will be
resolved relative to the current namespace if not an absolute qualified name.
If \fItargetObject\fR is omitted, a new name is chosen. The copied object will
be of the same class as the source object, and will have all its per-object
methods copied. If it is a class, it will also have all the class methods in
the class copied, but it will not have any of its instances copied. The








contents of the source object's private namespace \fIwill not\fR be copied; it





is up to the caller to do this. The result of this command will be the
fully-qualified name of the new object or class.
.SH EXAMPLES
.PP
This example creates an object, copies it, modifies the source object, and
then demonstrates that the copied object is indeed a copy.
.PP
.CS
oo::object create src







|
>
>
>
>
>
>
>
>
|
>
>
>
>
>
|
|







22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
The \fBoo::copy\fR command creates a copy of an object or class. It takes the
name of the object or class to be copied, \fIsourceObject\fR, and optionally
the name of the object or class to create, \fItargetObject\fR, which will be
resolved relative to the current namespace if not an absolute qualified name.
If \fItargetObject\fR is omitted, a new name is chosen. The copied object will
be of the same class as the source object, and will have all its per-object
methods copied. If it is a class, it will also have all the class methods in
the class copied, but it will not have any of its instances copied.
.PP
.VS
After the \fItargetObject\fR has been created and all definitions of its
configuration (e.g., methods, filters, mixins) copied, the \fB<cloned>\fR
method of \fItargetObject\fR will be invoked, to allow for customization of
the created object such as installing related variable traces. The only
argument given will be \fIsourceObject\fR. The default implementation of this
method (in \fBoo::object\fR) just copies the procedures and variables in the
namespace of \fIsourceObject\fR to the namespace of \fItargetObject\fR. If
this method call does not return a result that is successful (i.e., an error
or other kind of exception) then the \fItargetObject\fR will be deleted and an
error returned.
.VE
.PP
The result of the \fBoo::copy\fR command will be the fully-qualified name of
the new object or class.
.SH EXAMPLES
.PP
This example creates an object, copies it, modifies the source object, and
then demonstrates that the copied object is indeed a copy.
.PP
.CS
oo::object create src

Changes to doc/coroutine.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16


17

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33

34
35
36

























37
38
39
40
41
42
43
'\"
'\" Copyright (c) 2009 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.so man.macros
.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
coroutine, yield \- Create and produce values from coroutines
.SH SYNOPSIS
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?


\fIname\fR ?\fIvalue\fR?

.fi
.BE
.SH DESCRIPTION
.PP
The \fBcoroutine\fR command creates a new coroutine context (with associated
command) named \fIname\fR and executes that context by calling \fIcommand\fR,
passing in the other remaining arguments without further interpretation. Once
\fIcommand\fR returns normally or with an exception (e.g., an error) the
coroutine context \fIname\fR is deleted.
.PP
Within the context, values may be generated as results by using the
\fByield\fR command; if no \fIvalue\fR is supplied, the empty string is used.
When that is called, the context will suspend execution and the
\fBcoroutine\fR command will return the argument to \fByield\fR. The execution
of the context can then be resumed by calling the context command, optionally
passing in the value to use as the result of the \fByield\fR call that caused

the context to be suspended. If the coroutine context never yields and instead
returns conventionally, the result of the \fBcoroutine\fR command will be the
result of the evaluation of the context.

























.PP
The coroutine can also be deleted by destroying the command \fIname\fR, and
the name of the current coroutine can be retrieved by using
\fBinfo coroutine\fR.
If there are deletion traces on variables in the coroutine's
implementation, they will fire at the point when the coroutine is explicitly
deleted (or, naturally, if the command returns conventionally).











|




>
>
|
>















|
>



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







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
'\"
'\" Copyright (c) 2009 Donal K. Fellows.
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.so man.macros
.TH coroutine n 8.6 Tcl "Tcl Built-In Commands"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
coroutine, yield, yieldto \- Create and produce values from coroutines
.SH SYNOPSIS
.nf
\fBcoroutine \fIname command\fR ?\fIarg...\fR?
\fByield\fR ?\fIvalue\fR?
.VS TIP396
\fByieldto\fR \fIcommand\fR ?\fIarg...\fR?
\fIname\fR ?\fIvalue...\fR?
.VE TIP396
.fi
.BE
.SH DESCRIPTION
.PP
The \fBcoroutine\fR command creates a new coroutine context (with associated
command) named \fIname\fR and executes that context by calling \fIcommand\fR,
passing in the other remaining arguments without further interpretation. Once
\fIcommand\fR returns normally or with an exception (e.g., an error) the
coroutine context \fIname\fR is deleted.
.PP
Within the context, values may be generated as results by using the
\fByield\fR command; if no \fIvalue\fR is supplied, the empty string is used.
When that is called, the context will suspend execution and the
\fBcoroutine\fR command will return the argument to \fByield\fR. The execution
of the context can then be resumed by calling the context command, optionally
passing in the \fIsingle\fR value to use as the result of the \fByield\fR call
that caused
the context to be suspended. If the coroutine context never yields and instead
returns conventionally, the result of the \fBcoroutine\fR command will be the
result of the evaluation of the context.
.PP
.VS TIP396
The coroutine may also suspend its execution by use of the \fByieldto\fR
command, which instead of returning, cedes execution to some command called
\fIcommand\fR (resolved in the context of the coroutine) and to which \fIany
number\fR of arguments may be passed. Since every coroutine has a context
command, \fByieldto\fR can be used to transfer control directly from one
coroutine to another (this is only advisable if the two coroutines are
expecting this to happen) but \fIany\fR command may be the target. If a
coroutine is suspended by this mechanism, the coroutine processing can be
resumed by calling the context command optionally passing in an arbitrary
number of arguments. The return value of the \fByieldto\fR call will be the
list of arguments passed to the context command; it is up to the caller to
decide what to do with those values.
.PP
The recommended way of writing a version of \fByield\fR that allows resumption
with multiple arguments is by using \fByieldto\fR and the \fBreturn\fR
command, like this:
.PP
.CS
proc yieldm {value} {
    \fByieldto\fR return -level 0 $value
}
.CE
.VE TIP396
.PP
The coroutine can also be deleted by destroying the command \fIname\fR, and
the name of the current coroutine can be retrieved by using
\fBinfo coroutine\fR.
If there are deletion traces on variables in the coroutine's
implementation, they will fire at the point when the coroutine is explicitly
deleted (or, naturally, if the command returns conventionally).
104
105
106
107
108
109
110





















111
112
113
114
115
116
117
        set c [\fBcoroutine\fR prime$n filterByFactor $c $n]
    }
}} allNumbers
for {set i 1} {$i <= 20} {incr i} {
    puts "prime#$i = [\fIeratosthenes\fR]"
}
.CE





















.SS "DETAILED SEMANTICS"
.PP
This example demonstrates that coroutines start from the global namespace, and
that \fIcommand\fR resolution happens before the coroutine stack is created.
.PP
.CS
proc report {where level} {







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







133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
        set c [\fBcoroutine\fR prime$n filterByFactor $c $n]
    }
}} allNumbers
for {set i 1} {$i <= 20} {incr i} {
    puts "prime#$i = [\fIeratosthenes\fR]"
}
.CE
.PP
.VS TIP396
This example shows how a value can be passed around a group of three
coroutines that yield to each other:
.PP
.CS
proc juggler {name target {value ""}} {
    if {$value eq ""} {
        set value [\fByield\fR [info coroutine]]
    }
    while {$value ne ""} {
        puts "$name : $value"
        set value [string range $value 0 end-1]
        lassign [\fByieldto\fR $target $value] value
    }
}
\fBcoroutine\fR j1 juggler Larry [
    \fBcoroutine\fR j2 juggler Curly [
        \fBcoroutine\fR j3 juggler Moe j1]] "Nyuck!Nyuck!Nyuck!"
.CE
.VE TIP396
.SS "DETAILED SEMANTICS"
.PP
This example demonstrates that coroutines start from the global namespace, and
that \fIcommand\fR resolution happens before the coroutine stack is created.
.PP
.CS
proc report {where level} {

Changes to doc/define.n.

77
78
79
80
81
82
83
84
85


86
87
88
89
90

91

92
93
94
95
96
97
98
.
This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside an instance through the instance object's command) by the
class being defined. Note that the methods themselves may be actually defined
by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
\fBfilter\fR ?\fImethodName ...\fR?
.


This sets or updates the list of method names that are used to guard whether a
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
be exposed or not exposed); it is not an error for a non-existent method to be
named since they may be defined by subclasses. If no \fImethodName\fR

arguments are present, the list of filter names is set to empty.

.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded method called \fIname\fR. The method is
defined be forwarded to the command called \fIcmdName\fR, with additional
arguments, \fIarg\fR etc., added before those arguments specified by the
caller of the method. The \fIcmdName\fR will always be resolved using the







|
|
>
>
|



|
>
|
>







77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
.
This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside an instance through the instance object's command) by the
class being defined. Note that the methods themselves may be actually defined
by a superclass; subclass exports override superclass visibility, and may in
turn be overridden by instances.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of method names that are used to guard whether
method call to instances of the class may be called and what the method's
results are. Each \fImethodName\fR names a single filtering method (which may
be exposed or not exposed); it is not an error for a non-existent method to be
named since they may be defined by subclasses.
.VS
By default, this slot works by appending.
.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded method called \fIname\fR. The method is
defined be forwarded to the command called \fIcmdName\fR, with additional
arguments, \fIarg\fR etc., added before those arguments specified by the
caller of the method. The \fIcmdName\fR will always be resolved using the
110
111
112
113
114
115
116
117
118


119
120
121
122



123
124
125
126
127
128
129
be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When
the body of the method is evaluated, the current namespace of the method will
be a namespace that is unique to the current object. The method will be
exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
\fBunexport\fR.
.TP
\fBmixin\fR ?\fIclassName ...\fR?
.


This sets or updates the list of additional classes that are to be mixed into
all the instances of the class being defined. Each \fIclassName\fR argument
names a single class that is to be mixed in; if no classes are present, the
list of mixed-in classes is set to be empty.



.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class







|
|
>
>
|

|
<
>
>
>







114
115
116
117
118
119
120
121
122
123
124
125
126
127

128
129
130
131
132
133
134
135
136
137
be \fIargList\fR, and the body of the method will be \fIbodyScript\fR. When
the body of the method is evaluated, the current namespace of the method will
be a namespace that is unique to the current object. The method will be
exported if \fIname\fR starts with a lower-case letter, and non-exported
otherwise; this behavior can be overridden via \fBexport\fR and
\fBunexport\fR.
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of additional classes that are to be mixed into
all the instances of the class being defined. Each \fIclassName\fR argument
names a single class that is to be mixed in.

.VS
By default, this slot works by replacement.
.VE
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in a class to \fItoName\fR. The
method must have previously existed in the class, and \fItoName\fR must not
previously refer to a method in that class. Does not affect the superclasses
of the class, nor does it affect the subclasses or instances of the class
140
141
142
143
144
145
146
147
148


149
150
151
152





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

165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
supported values of \fIsubcommand\fR). It follows the same general pattern of
argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands,
and
.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
operates identically to
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
.TP
\fBsuperclass\fI className \fR?\fIclassName ...\fR?
.


This allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
being non-classes or vice-versa.





.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the instance through the instance object's command,
but instead just through the \fBmy\fR command visible in each object's
context) by the class being defined. Note that the methods themselves may be
actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
\fBvariable\fR ?\fIname ...\fR?
.VS

This arranges for each of the named variables to be automatically made
available in the methods, constructor and destructor declared by the class
being defined. Note that the list of variable names is the whole list of
variable names for the class. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the instance object on which the method is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
class.
.VE
.SS "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
.TP







|
|
>
>
|


|
>
>
>
>
>










|

>
|

<
|





|







148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

183
184
185
186
187
188
189
190
191
192
193
194
195
196
supported values of \fIsubcommand\fR). It follows the same general pattern of
argument handling as the \fBoo::define\fR and \fBoo::objdefine\fR commands,
and
.QW "\fBoo::define \fIcls \fBself \fIsubcommand ...\fR"
operates identically to
.QW "\fBoo::objdefine \fIcls subcommand ...\fR" .
.TP
\fBsuperclass\fI ?\fI\-slotOperation\fR? \fR?\fIclassName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
allows the alteration of the superclasses of the class being defined.
Each \fIclassName\fR argument names one class that is to be a superclass of
the defined class. Note that objects must not be changed from being classes to
being non-classes or vice-versa, that an empty parent class is equivalent to
\fBoo::object\fR, and that the parent classes of \fBoo::object\fR and
\fBoo::class\fR may not be modified.
.VS
By default, this slot works by replacement.
.VE
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the instance through the instance object's command,
but instead just through the \fBmy\fR command visible in each object's
context) by the class being defined. Note that the methods themselves may be
actually defined by a superclass; subclass unexports override superclass
visibility, and may be overridden by instance unexports.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made
available in the methods, constructor and destructor declared by the class

being defined. Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the instance object on which the method is executed. Note
that the variable lists declared by a superclass or subclass are completely
disjoint, as are variable lists declared by instances; the list of variable
names is just for methods (and constructors and destructors) declared by this
class. By default, this slot works by appending.
.VE
.SS "CONFIGURING OBJECTS"
.PP
The following commands are supported in the \fIdefScript\fR for
\fBoo::objdefine\fR, each of which may also be used in the \fIsubcommand\fR
form:
.TP
194
195
196
197
198
199
200
201
202


203
204
205
206
207
208
209



210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231


232
233
234

235

236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262























































263
264
265
266
267
268
269
\fBexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside the object through the object's command) by the object
being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
\fBfilter\fR ?\fImethodName ...\fR?
.


This sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
not exposed); it is not an error for a non-existent method to be named. If no
\fImethodName\fR arguments are present, the list of filter names is set to
empty. Note that the actual list of filters also depends on the filters set
upon any classes that the object is an instance of.



.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded object method called \fIname\fR. The
method is defined be forwarded to the command called \fIcmdName\fR, with
additional arguments, \fIarg\fR etc., added before those arguments specified
by the caller of the method. Forwarded methods should be deleted using the
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
a lower-case letter, and non-exported otherwise.
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates, updates or deletes an object method. The name of the method is
\fIname\fR, the formal arguments to the method (defined using the same format
as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
method will be \fIbodyScript\fR. When the body of the method is evaluated, the
current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
letter, and non-exported otherwise.
.TP
\fBmixin\fR ?\fIclassName ...\fR?
.


This sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
that is to be mixed in; if no classes are present, the list of mixed-in

classes is set to be empty.

.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the object through the object's command, but instead
just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
\fBvariable\fR ?\fIname ...\fR?
.VS
This arranges for each of the named variables to be automatically made
available in the methods declared by the object being defined. Note that the
list of variable names is the whole list of variable names for the object.
Each variable name must not have any namespace separators and must not look
like an array access. All variables will be actually present in the object on
which the method is executed. Note that the variable lists declared by the
classes and mixins of which the object is an instance are completely disjoint;
the list of variable names is just for methods declared by this object.























































.VE
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
illustrating four of the subcommands of them.
.PP
.CS







|
|
>
>
|


|
<
|
|
>
>
>




















|
|
>
>
|

|
>
|
>

















|

|
|
<
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







209
210
211
212
213
214
215
216
217
218
219
220
221
222
223

224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279

280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
\fBexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be exported
(i.e. usable outside the object through the object's command) by the object
being defined. Note that the methods themselves may be actually defined by a
class or superclass; object exports override class visibility.
.TP
\fBfilter\fR ?\fI\-slotOperation\fR? ?\fImethodName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates the list of method names that are used to guard whether a
method call to the object may be called and what the method's results are.
Each \fImethodName\fR names a single filtering method (which may be exposed or
not exposed); it is not an error for a non-existent method to be named. Note

that the actual list of filters also depends on the filters set upon any
classes that the object is an instance of.
.VS
By default, this slot works by appending.
.VE
.TP
\fBforward\fI name cmdName \fR?\fIarg ...\fR?
.
This creates or updates a forwarded object method called \fIname\fR. The
method is defined be forwarded to the command called \fIcmdName\fR, with
additional arguments, \fIarg\fR etc., added before those arguments specified
by the caller of the method. Forwarded methods should be deleted using the
\fBmethod\fR subcommand. The method will be exported if \fIname\fR starts with
a lower-case letter, and non-exported otherwise.
.TP
\fBmethod\fI name argList bodyScript\fR
.
This creates, updates or deletes an object method. The name of the method is
\fIname\fR, the formal arguments to the method (defined using the same format
as for the Tcl \fBproc\fR command) will be \fIargList\fR, and the body of the
method will be \fIbodyScript\fR. When the body of the method is evaluated, the
current namespace of the method will be a namespace that is unique to the
object. The method will be exported if \fIname\fR starts with a lower-case
letter, and non-exported otherwise.
.TP
\fBmixin\fR ?\fI\-slotOperation\fR? ?\fIclassName ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below)
.VE
sets or updates a per-object list of additional classes that are to be
mixed into the object. Each argument, \fIclassName\fR, names a single class
that is to be mixed in.
.VS
By default, this slot works by replacement.
.VE
.TP
\fBrenamemethod\fI fromName toName\fR
.
This renames the method called \fIfromName\fR in an object to \fItoName\fR.
The method must have previously existed in the object, and \fItoName\fR must
not previously refer to a method in that object. Does not affect the classes
that the object is an instance of. Does not change the export status of the
method; if it was exported before, it will be afterwards.
.TP
\fBunexport\fI name \fR?\fIname ...\fR?
.
This arranges for each of the named methods, \fIname\fR, to be not exported
(i.e. not usable outside the object through the object's command, but instead
just through the \fBmy\fR command visible in the object's context) by the
object being defined. Note that the methods themselves may be actually defined
by a class; instance unexports override class visibility.
.TP
\fBvariable\fR ?\fI\-slotOperation\fR? ?\fIname ...\fR?
.VS
This slot (see \fBSLOTTED DEFINITIONS\fR below) arranges for each of the named
variables to be automatically made available in the methods declared by the

object being defined.  Each variable name must not have any namespace
separators and must not look like an array access. All variables will be
actually present in the object on which the method is executed. Note that the
variable lists declared by the classes and mixins of which the object is an
instance are completely disjoint; the list of variable names is just for
methods declared by this object. By default, this slot works by appending.
.SH "SLOTTED DEFINITIONS"
Some of the configurable definitions of a class or object are \fIslotted
definitions\fR. This means that the configuration is implemented by a slot
object, that is an instance of the class \fBoo::Slot\fR, which manages a list
of values (class names, variable names, etc.) that comprises the contents of
the slot. The class defines three operations (as methods) that may be done on
the slot:
.VE
.TP
\fIslot\fR \fB\-append\fR ?\fImember ...\fR?
.VS
This appends the given \fImember\fR elements to the slot definition.
.VE
.TP
\fIslot\fR \fB\-clear\fR
.VS
This sets the slot definition to the empty list.
.VE
.TP
\fIslot\fR \fB\-set\fR ?\fImember ...\fR?
.VS
This replaces the slot definition with the given \fImember\fR elements.
.PP
A consequence of this is that any use of a slot's default operation where the
first member argument begins with a hyphen will be an error. One of the above
operations should be used explicitly in those circumstances.
.SS "SLOT IMPLEMENTATION"
Internally, slot objects also define a method \fB\-\-default\-operation\fR
which is forwarded to the default operation of the slot (thus, for the class
.QW \fBvariable\fR
slot, this is forwarded to
.QW "\fBmy \-append\fR" ),
and these methods which provide the implementation interface:
.VE
.TP
\fIslot\fR \fBGet\fR
.VS
Returns a list that is the current contents of the slot. This method must
always be called from a stack frame created by a call to \fBoo::define\fR or
\fBoo::objdefine\fR.
.VE
.TP
\fIslot\fR \fBSet \fIelementList\fR
.VS
Sets the contents of the slot to the list \fIelementList\fR and returns the
empty string. This method must always be called from a stack frame created by
a call to \fBoo::define\fR or \fBoo::objdefine\fR.
.PP
The implementation of these methods is slot-dependent (and responsible for
accessing the correct part of the class or object definition). Slots also have
an unknown method handler to tie all these pieces together, and they hide
their \fBdestroy\fR method so that it is not invoked inadvertently. It is
\fIrecommended\fR that any user changes to the slot mechanism be restricted to
defining new operations whose names start with a hyphen.
.VE
.SH EXAMPLES
This example demonstrates how to use both forms of the \fBoo::define\fR and
\fBoo::objdefine\fR commands (they work in the same way), as well as
illustrating four of the subcommands of them.
.PP
.CS
282
283
284
285
286
287
288































289
290
291
292
293
294
295
296
297
}
o bar                \fI\(-> prints "hello world"\fR
o foo                \fI\(-> error "unknown method foo"\fR
o Foo Bar            \fI\(-> error "unknown method Foo"\fR
\fBoo::objdefine\fR o \fBrenamemethod\fR bar lollipop
o lollipop           \fI\(-> prints "hello world"\fR
.CE































.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
class, definition, method, object

.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:







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



|
<




359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400

401
402
403
404
}
o bar                \fI\(-> prints "hello world"\fR
o foo                \fI\(-> error "unknown method foo"\fR
o Foo Bar            \fI\(-> error "unknown method Foo"\fR
\fBoo::objdefine\fR o \fBrenamemethod\fR bar lollipop
o lollipop           \fI\(-> prints "hello world"\fR
.CE
.PP
This example shows how additional classes can be mixed into an object. It also
shows how \fBmixin\fR is a slot that supports appending:
.PP
.CS
oo::object create inst
inst m1              \fI\(-> error "unknown method m1"\fR
inst m2              \fI\(-> error "unknown method m2"\fR

oo::class create A {
    \fBmethod\fR m1 {} {
        puts "red brick"
    }
}
\fBoo::objdefine\fR inst {
    \fBmixin\fR A
}
inst m1              \fI\(-> prints "red brick"\fR
inst m2              \fI\(-> error "unknown method m2"\fR

oo::class create B {
    \fBmethod\fR m2 {} {
        puts "blue brick"
    }
}
\fBoo::objdefine\fR inst {
    \fBmixin -append\fR B
}
inst m1              \fI\(-> prints "red brick"\fR
inst m2              \fI\(-> prints "blue brick"\fR
.CE
.SH "SEE ALSO"
next(n), oo::class(n), oo::object(n)
.SH KEYWORDS
class, definition, method, object, slot

.\" Local variables:
.\" mode: nroff
.\" fill-column: 78
.\" End:

Changes to doc/gets.n.

31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
command.
If \fIvarName\fR is specified then the line is placed in the variable by
that name and the return value is a count of the number of characters
returned.
.PP
If end of file occurs while scanning for an end of
line, the command returns whatever input is available up to the end of file.
If \fIchannelId\fR is in nonblocking mode and there is not a full
line of input available, the command returns an empty string and
does not consume any input.
If \fIvarName\fR is specified and an empty string is returned in
\fIvarName\fR because of end-of-file or because of insufficient
data in nonblocking mode, then the return count is -1.
Note that if \fIvarName\fR is not specified then the end-of-file
and no-full-line-available cases can
produce the same results as if there were an input line consisting
only of the end-of-line character(s).
The \fBeof\fR and \fBfblocked\fR commands can be used to distinguish
these three cases.
.SH "EXAMPLE"







|




|







31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
command.
If \fIvarName\fR is specified then the line is placed in the variable by
that name and the return value is a count of the number of characters
returned.
.PP
If end of file occurs while scanning for an end of
line, the command returns whatever input is available up to the end of file.
If \fIchannelId\fR is in non-blocking mode and there is not a full
line of input available, the command returns an empty string and
does not consume any input.
If \fIvarName\fR is specified and an empty string is returned in
\fIvarName\fR because of end-of-file or because of insufficient
data in non-blocking mode, then the return count is -1.
Note that if \fIvarName\fR is not specified then the end-of-file
and no-full-line-available cases can
produce the same results as if there were an input line consisting
only of the end-of-line character(s).
The \fBeof\fR and \fBfblocked\fR commands can be used to distinguish
these three cases.
.SH "EXAMPLE"
60
61
62
63
64
65
66
67




close $chan
.CE

.SH "SEE ALSO"
file(n), eof(n), fblocked(n), Tcl_StandardChannels(3)

.SH KEYWORDS
blocking, channel, end of file, end of line, line, nonblocking, read











|
>
>
>
>
60
61
62
63
64
65
66
67
68
69
70
71
close $chan
.CE

.SH "SEE ALSO"
file(n), eof(n), fblocked(n), Tcl_StandardChannels(3)

.SH KEYWORDS
blocking, channel, end of file, end of line, line, non-blocking, read
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/info.n.

1
2
3
4
5
6
7
8
9
10
11
12
13
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 1998-2000 Ajuba Solutions
'\" Copyright (c) 2007-2008 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.so man.macros
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.BS





|







1
2
3
4
5
6
7
8
9
10
11
12
13
'\"
'\" Copyright (c) 1993 The Regents of the University of California.
'\" Copyright (c) 1994-1997 Sun Microsystems, Inc.
'\" Copyright (c) 1993-1997 Bell Labs Innovations for Lucent Technologies
'\" Copyright (c) 1998-2000 Ajuba Solutions
'\" Copyright (c) 2007-2012 Donal K. Fellows
'\"
'\" See the file "license.terms" for information on usage and redistribution
'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
'\" 
.so man.macros
.TH info n 8.4 Tcl "Tcl Built-In Commands"
.BS
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100

101
102
103
104
105
106


107
108
109
110
111
112
113
114
115
116

117
118
119
120
121
122
123
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines;  if the
command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
.VS 8.6
Returns the name of the currently executing coroutine, or the empty string if
either no coroutine is currently executing, or the current coroutine has been
deleted (but has not yet returned or yielded since deletion).
.VE 8.6
.TP
\fBinfo default \fIprocname arg varname\fR
.
\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
must be the name of an argument to that procedure.  If \fIarg\fR
does not have a default value then the command returns \fB0\fR.
Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.VS 8.6
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.


This form is an even-sized list alternating tokens and parameters. Tokens are
currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be
introduced in the future. \fBCALL\fR indicates a procedure call, and its
parameter is the corresponding [info level 0]. \fBUP\fR indicates a shift in
variable frames generated by uplevel or similar, and applies to the previous
CALL item. Its parameter is the level offset. \fBINNER\fR identifies the


"inner context", which is the innermost atomic command or bytecode instruction
that raised the error, along with its arguments when available. While
\fBCALL\fR and \fBUP\fR allow to follow complex call paths, \fBINNER\fR homes
in on the offending operation in the innermost proc call, even going to
sub-expr granularity.

This information is also present in the
\fB\-errorstack\fR entry of the options dictionary returned by 3-argument
\fBcatch\fR; \fBinfo errorstack\fR is a convenient way of retrieving it for
uncaught errors at toplevel in an interactive tclsh.

.VE 8.6
.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.







|
|
|















|
>



|
|
|
>
>
|
|
|
|
|
|
|
|
|
|
>







75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
This command is typically used in line-oriented input environments
to allow users to type in commands that span multiple lines;  if the
command is not complete, the script can delay evaluating it until additional
lines have been typed to complete the command.
.TP
\fBinfo coroutine\fR
.VS 8.6
Returns the name of the currently executing \fBcoroutine\fR, or the empty
string if either no coroutine is currently executing, or the current coroutine
has been deleted (but has not yet returned or yielded since deletion).
.VE 8.6
.TP
\fBinfo default \fIprocname arg varname\fR
.
\fIProcname\fR must be the name of a Tcl command procedure and \fIarg\fR
must be the name of an argument to that procedure.  If \fIarg\fR
does not have a default value then the command returns \fB0\fR.
Otherwise it returns \fB1\fR and places the default value of \fIarg\fR
into variable \fIvarname\fR.
.TP
\fBinfo errorstack \fR?\fIinterp\fR?
.VS 8.6
Returns, in a form that is programmatically easy to parse, the function names
and arguments at each level from the call stack of the last error in the given
\fIinterp\fR, or in the current one if not specified.
.RS
.PP
This form is an even-sized list alternating tokens and parameters. Tokens are
currently either \fBCALL\fR, \fBUP\fR, or \fBINNER\fR, but other values may be
introduced in the future. \fBCALL\fR indicates a procedure call, and its
parameter is the corresponding \fBinfo level\fR \fB0\fR. \fBUP\fR indicates a
shift in variable frames generated by \fBuplevel\fR or similar, and applies to
the previous \fBCALL\fR item. Its parameter is the level offset. \fBINNER\fR
identifies the
.QW "inner context" ,
which is the innermost atomic command or bytecode instruction that raised the
error, along with its arguments when available. While \fBCALL\fR and \fBUP\fR
allow to follow complex call paths, \fBINNER\fR homes in on the offending
operation in the innermost procedure call, even going to sub-expression
granularity.
.PP
This information is also present in the \fB\-errorstack\fR entry of the
options dictionary returned by 3-argument \fBcatch\fR; \fBinfo errorstack\fR
is a convenient way of retrieving it for uncaught errors at top-level in an
interactive \fBtclsh\fR.
.RE
.VE 8.6
.TP
\fBinfo exists \fIvarName\fR
.
Returns \fB1\fR if the variable named \fIvarName\fR exists in the
current context (either as a global or local variable) and has been
defined by being given a value, returns \fB0\fR otherwise.
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200

201
202
203
204
205
206
207
208
209
.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
means that the command is executed by \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
means that the command is found in a precompiled script (loadable by
the package \fBtbcload\fR), and no further information will be
available.
.RE
.TP
\fBline\fR
.
This entry provides the number of the line the command is at inside of
the script it is a part of. This information is not present for type
\fBprecompiled\fR. For type \fBsource\fR this information is counted
relative to the beginning of the file, whereas for the last two types
the line is counted relative to the start of the script.
.TP
\fBfile\fR
.
This entry is present only for type \fBsource\fR. It provides the
normalized path of the file the command is in.
.TP
\fBcmd\fR
.
This entry provides the string representation of the command. This is
usually the unsubstituted form, however for commands which are a pure

list executed by eval it is the substituted form as they have no other
string representation. Care is taken that the pure-List property of
the latter is not spoiled.
.TP
\fBproc\fR
.
This entry is present only if the command is found in the body of a
regular Tcl procedure. It then provides the name of that procedure.
.TP







|




















|
>
|
|







176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
.TP
\fBeval\fR\0\0\0\0\0\0\0\0
.
means that the command is executed by \fBeval\fR or \fBuplevel\fR.
.TP
\fBprecompiled\fR\0\0\0\0\0\0\0\0
.
means that the command is found in a pre-compiled script (loadable by
the package \fBtbcload\fR), and no further information will be
available.
.RE
.TP
\fBline\fR
.
This entry provides the number of the line the command is at inside of
the script it is a part of. This information is not present for type
\fBprecompiled\fR. For type \fBsource\fR this information is counted
relative to the beginning of the file, whereas for the last two types
the line is counted relative to the start of the script.
.TP
\fBfile\fR
.
This entry is present only for type \fBsource\fR. It provides the
normalized path of the file the command is in.
.TP
\fBcmd\fR
.
This entry provides the string representation of the command. This is
usually the unsubstituted form, however for commands which are a
canonically-constructed list (e.g., as produced by the \fBlist\fR command)
executed by \fBeval\fR it is the substituted form as they have no other
string representation. Care is taken that the canonicality property of
the latter is not spoiled.
.TP
\fBproc\fR
.
This entry is present only if the command is found in the body of a
regular Tcl procedure. It then provides the name of that procedure.
.TP
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
A thing of note is that for procedures statically defined in files the
locations of commands in their bodies will be reported with type
\fBsource\fR and absolute line numbers, and not as type
\fBproc\fR. The same is true for procedures nested in statically
defined procedures, and literal eval scripts in files or statically
defined procedures.
.PP
In contrast, a procedure definition or \fBeval\fR within a dynamically
\fBeval\fRuated environment count linenumbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
.PP
A different way of describing this behaviour is that file based
locations are tracked as deeply as possible, and where this is not
possible the lines are counted based on the smallest possible
\fBeval\fR or procedure body, as that scope is usually easier to find
than any dynamic outer scope.
.PP
The syntactic form \fB{*}\fR is handled like \fBeval\fR. I.e. if it
is given a literal list argument the system tracks the linenumber
within the list words as well, and otherwise all linenumbers are
counted relative to the start of each word (smallest scope)
.RE
.TP
\fBinfo functions \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of all the math
functions currently defined.







|
|











|
|







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
A thing of note is that for procedures statically defined in files the
locations of commands in their bodies will be reported with type
\fBsource\fR and absolute line numbers, and not as type
\fBproc\fR. The same is true for procedures nested in statically
defined procedures, and literal eval scripts in files or statically
defined procedures.
.PP
In contrast, procedure definitions and \fBeval\fR within a dynamically
\fBeval\fRuated environment count line numbers relative to the start of
their script, even if they would be able to count relative to the
start of the outer dynamic script. That type of number usually makes
more sense.
.PP
A different way of describing this behaviour is that file based
locations are tracked as deeply as possible, and where this is not
possible the lines are counted based on the smallest possible
\fBeval\fR or procedure body, as that scope is usually easier to find
than any dynamic outer scope.
.PP
The syntactic form \fB{*}\fR is handled like \fBeval\fR. I.e. if it
is given a literal list argument the system tracks the line number
within the list words as well, and otherwise all line numbers are
counted relative to the start of each word (smallest scope)
.RE
.TP
\fBinfo functions \fR?\fIpattern\fR?
.
If \fIpattern\fR is not specified, returns a list of all the math
functions currently defined.
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
actually use \fBnext\fR to transfer control along the call chain.
.RE
.VE 8.6
.TP
\fBinfo class constructor\fI class\fR
.VS 8.6
This subcommand returns a description of the definition of the constructor of
class \fIclass\fR. The defintion is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
passing to another call to \fBproc\fR or a method defintion, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.
.VE 8.6
.TP
\fBinfo class definition\fI class method\fR
.VS 8.6
This subcommand returns a description of the definition of the method named
\fImethod\fR of class \fIclass\fR. The defintion is described as a two element
list; the first element is the list of arguments to the method in a form
suitable for passing to another call to \fBproc\fR or a method defintion, and
the second element is the body of the method.
.VE 8.6
.TP
\fBinfo class destructor\fI class\fR
.VS 8.6
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.







|

|







|

|







426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
actually use \fBnext\fR to transfer control along the call chain.
.RE
.VE 8.6
.TP
\fBinfo class constructor\fI class\fR
.VS 8.6
This subcommand returns a description of the definition of the constructor of
class \fIclass\fR. The definition is described as a two element list; the first
element is the list of arguments to the constructor in a form suitable for
passing to another call to \fBproc\fR or a method definition, and the second
element is the body of the constructor. If no constructor is present, this
returns the empty list.
.VE 8.6
.TP
\fBinfo class definition\fI class method\fR
.VS 8.6
This subcommand returns a description of the definition of the method named
\fImethod\fR of class \fIclass\fR. The definition is described as a two element
list; the first element is the list of arguments to the method in a form
suitable for passing to another call to \fBproc\fR or a method definition, and
the second element is the body of the method.
.VE 8.6
.TP
\fBinfo class destructor\fI class\fR
.VS 8.6
This subcommand returns the body of the destructor of class \fIclass\fR. If no
destructor is present, this returns the empty string.
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.VE 8.6
.TP
\fBinfo object definition\fI object method\fR
.VS 8.6
This subcommand returns a description of the definition of the method named
\fImethod\fR of object \fIobject\fR. The defintion is described as a two
element list; the first element is the list of arguments to the method in a
form suitable for passing to another call to \fBproc\fR or a method defintion,
and the second element is the body of the method.
.VE 8.6
.TP
\fBinfo object filters\fI object\fR
.VS 8.6
This subcommand returns the list of filter methods set on the object.
.VE 8.6







|

|







560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
\fIobject\fR object. If \fIclassName\fR is present, this subcommand returns a
boolean value indicating whether the \fIobject\fR is of that class.
.VE 8.6
.TP
\fBinfo object definition\fI object method\fR
.VS 8.6
This subcommand returns a description of the definition of the method named
\fImethod\fR of object \fIobject\fR. The definition is described as a two
element list; the first element is the list of arguments to the method in a
form suitable for passing to another call to \fBproc\fR or a method definition,
and the second element is the body of the method.
.VE 8.6
.TP
\fBinfo object filters\fI object\fR
.VS 8.6
This subcommand returns the list of filter methods set on the object.
.VE 8.6
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.VS 8.6
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
that constrains the list of variables returned. Note that this is different
from the lit returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).
.VE 8.6
.SH EXAMPLES
.PP
This command prints out a procedure suitable for saving in a Tcl







|







672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
.TP
\fBinfo object vars\fI object\fR ?\fIpattern\fR?
.VS 8.6
This subcommand returns a list of all variables in the private namespace of
the object named \fIobject\fR. If the optional \fIpattern\fR argument is
given, it is a filter (in the syntax of a \fBstring match\fR glob pattern)
that constrains the list of variables returned. Note that this is different
from the list returned by \fBinfo object variables\fR; that can include
variables that are currently unset, whereas this can include variables that
are not automatically included by any of \fIobject\fR's methods (or those of
its class, superclasses or mixins).
.VE 8.6
.SH EXAMPLES
.PP
This command prints out a procedure suitable for saving in a Tcl
727
728
729
730
731
732
733
734
735
736
737

738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
            return [\fBinfo class definition\fR $locus $name]
        }
    }
    error "no definition for $method"
}
.CE
.PP
This is an alternate way of implementing the definition lookup is by manually
scanning the list of methods up the inheritance tree. This code assumes that
only single inheritance is in use, and that there is no complex use of
mixed-in classes:

.PP
.CS
proc getDef {obj method} {
    if {$method in [\fBinfo object methods\fR $obj]} {
        # Assume no forwards
        return [\fBinfo object definition\fR $obj $method]
    }
    set cls [\fBinfo object class\fR $obj]
    while {$method ni [\fBinfo class methods\fR $cls]} {
        # Assume the simple case
        set cls [lindex [\fBinfo class superclass\fR $cls] 0]
        if {$cls eq {}} {
            error "no definition for $method"
        }
    }
    # Assume no forwards
    return [\fBinfo class definition\fR $cls $method]
}
.CE







|
|
|
|
>











|







732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
            return [\fBinfo class definition\fR $locus $name]
        }
    }
    error "no definition for $method"
}
.CE
.PP
This is an alternate way of looking up the definition; it is implemented by
manually scanning the list of methods up the inheritance tree. This code
assumes that only single inheritance is in use, and that there is no complex
use of mixed-in classes (in such cases, using \fBinfo object call\fR as above
is the simplest way of doing this by far):
.PP
.CS
proc getDef {obj method} {
    if {$method in [\fBinfo object methods\fR $obj]} {
        # Assume no forwards
        return [\fBinfo object definition\fR $obj $method]
    }
    set cls [\fBinfo object class\fR $obj]
    while {$method ni [\fBinfo class methods\fR $cls]} {
        # Assume the simple case
        set cls [lindex [\fBinfo class superclass\fR $cls] 0]
        if {$cls eq ""} {
            error "no definition for $method"
        }
    }
    # Assume no forwards
    return [\fBinfo class definition\fR $cls $method]
}
.CE

Changes to doc/mathfunc.n.

295
296
297
298
299
300
301




expr(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
.nf
Copyright (c) 1993 The Regents of the University of California.
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
Copyright (c) 2005, 2006 by Kevin B. Kenny <[email protected]>.
.fi











>
>
>
>
295
296
297
298
299
300
301
302
303
304
305
expr(n), mathop(n), namespace(n)
.SH "COPYRIGHT"
.nf
Copyright (c) 1993 The Regents of the University of California.
Copyright (c) 1994-2000 Sun Microsystems Incorporated.
Copyright (c) 2005, 2006 by Kevin B. Kenny <[email protected]>.
.fi
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/my.n.

27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(i.e. the object that is returned by \fBself object\fR) from which the
\fBmy\fR command is invoked.
.PP
Each object has its own \fBmy\fR command, contained in its instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
the \fBoo::object\fR class, which is not publically visible by default:
.PP
.CS
oo::class create c {
    method count {} {
        \fBmy\fR variable counter
        print [incr counter]
    }







|







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
(i.e. the object that is returned by \fBself object\fR) from which the
\fBmy\fR command is invoked.
.PP
Each object has its own \fBmy\fR command, contained in its instance namespace.
.SH EXAMPLES
.PP
This example shows basic use of \fBmy\fR to use the \fBvariables\fR method of
the \fBoo::object\fR class, which is not publicly visible by default:
.PP
.CS
oo::class create c {
    method count {} {
        \fBmy\fR variable counter
        print [incr counter]
    }

Changes to doc/next.n.

78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
.PP
Any particular method implementation always comes as \fIlate\fR in the
resulting list of implementations as possible.
.SS FILTERS
.PP
When an object has a list of filter names set upon it, or is an instance of a
class (or has mixed in a class) that has a list of filter names set upon it,
before every invokation of any method the filters are processed. Filter
implementations are found in class traversal order, as are the lists of filter
names (each of which is traversed in natural list order). Explicitly invoking
a method used as a filter will cause that method to be invoked twice, once as
a filter and once as a normal method.
.PP
Each filter should decide for itself whether to permit the execution to go
forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
Filters are not invoked when processing an invokation of the \fBunknown\fR
method because of a failure to locate a method implementation, or when
invoking either constructors or destructors.
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the
(super)class's implementation of a method. The script:
.PP







|










|







78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
.PP
Any particular method implementation always comes as \fIlate\fR in the
resulting list of implementations as possible.
.SS FILTERS
.PP
When an object has a list of filter names set upon it, or is an instance of a
class (or has mixed in a class) that has a list of filter names set upon it,
before every invocation of any method the filters are processed. Filter
implementations are found in class traversal order, as are the lists of filter
names (each of which is traversed in natural list order). Explicitly invoking
a method used as a filter will cause that method to be invoked twice, once as
a filter and once as a normal method.
.PP
Each filter should decide for itself whether to permit the execution to go
forward to the proper implementation of the method (which it does by invoking
the \fBnext\fR command as filters are inserted into the front of the method
call chain) and is responsible for returning the result of \fBnext\fR.
.PP
Filters are not invoked when processing an invocation of the \fBunknown\fR
method because of a failure to locate a method implementation, or when
invoking either constructors or destructors.
.SH EXAMPLES
.PP
This example demonstrates how to use the \fBnext\fR command to call the
(super)class's implementation of a method. The script:
.PP
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
per-object method, args = 1 2 3
before chaining from subclass, args = x 1 2 3 y
in the superclass, args = a x 1 2 3 y b
in the superclass, args = pureSynthesis
after chaining from subclass
before chaining from subclass, args = 
in the superclass, args = a b
in the superclassm args = pureSynthesis
after chaining from subclass
.CE
.PP
This example demonstrates how to build a simple cache class that applies
memoization to all the method calls of the objects it is mixed into, and shows
how it can make a difference to computation times:
.PP







|







131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
per-object method, args = 1 2 3
before chaining from subclass, args = x 1 2 3 y
in the superclass, args = a x 1 2 3 y b
in the superclass, args = pureSynthesis
after chaining from subclass
before chaining from subclass, args = 
in the superclass, args = a b
in the superclass, args = pureSynthesis
after chaining from subclass
.CE
.PP
This example demonstrates how to build a simple cache class that applies
memoization to all the method calls of the objects it is mixed into, and shows
how it can make a difference to computation times:
.PP
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

        \fI# Compute value, insert into cache, and return it\fR
        return [set ValueCache($key) [\fBnext\fR {*}$args]]
    }
    method flushCache {} {
        my variable ValueCache
        unset ValueCache
        \fI# Skip the cacheing\fR
        return -level 2 ""
    }
}

oo::object create demo
oo::define demo {
    mixin cache







|







161
162
163
164
165
166
167
168
169
170
171
172
173
174
175

        \fI# Compute value, insert into cache, and return it\fR
        return [set ValueCache($key) [\fBnext\fR {*}$args]]
    }
    method flushCache {} {
        my variable ValueCache
        unset ValueCache
        \fI# Skip the caching\fR
        return -level 2 ""
    }
}

oo::object create demo
oo::define demo {
    mixin cache

Changes to doc/object.n.

36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
.PP
Each object has a unique namespace associated with it, the instance namespace.
This namespace holds all the instance variables of the object, and will be the
current namespace whenever a method of the object is invoked (including a
method of the class of the object). When the object is destroyed, its instance
namespace is deleted. The instance namespace contains the object's \fBmy\fR
command, which may be used to invoke non-exported methods of the object or to
create a reference to the object for the purpose of invokation which persists
across renamings of the object.
.SS CONSTRUCTOR
The \fBoo::object\fR class does not define an explicit constructor.
.SS DESTRUCTOR
The \fBoo::object\fR class does not define an explicit destructor.
.SS "EXPORTED METHODS"
The \fBoo::object\fR class supports the following exported methods:







|







36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
.PP
Each object has a unique namespace associated with it, the instance namespace.
This namespace holds all the instance variables of the object, and will be the
current namespace whenever a method of the object is invoked (including a
method of the class of the object). When the object is destroyed, its instance
namespace is deleted. The instance namespace contains the object's \fBmy\fR
command, which may be used to invoke non-exported methods of the object or to
create a reference to the object for the purpose of invocation which persists
across renamings of the object.
.SS CONSTRUCTOR
The \fBoo::object\fR class does not define an explicit constructor.
.SS DESTRUCTOR
The \fBoo::object\fR class does not define an explicit destructor.
.SS "EXPORTED METHODS"
The \fBoo::object\fR class supports the following exported methods:
61
62
63
64
65
66
67
68
69
70
71
72





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










89
90
91
92
93
94
95
.TP
\fIobj \fBeval\fR ?\fIarg ...\fR?
.
This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR,
and then evaluates the resulting script in the namespace that is uniquely
associated with \fIobj\fR, returning the result of the evaluation.
.TP
\fIobj \fBunknown \fImethodName\fR ?\fIarg ...\fR?
.
This method is called when an attempt to invoke the method \fImethodName\fR on
object \fIobj\fR fails. The arguments that the user supplied to the method are
given as \fIarg\fR argments. The default implementation (i.e. the one defined





by the \fBoo::object\fR class) generates a suitable error, detailing what
methods the object supports given whether the object was invoked by its public
name or through the \fBmy\fR command.
.TP
\fIobj \fBvariable \fR?\fIvarName ...\fR?
.
This method arranges for each variable called \fIvarName\fR to be linked from
the object \fIobj\fR's unique namespace into the caller's context. Thus, if it
is invoked from inside a procedure then the namespace variable in the object
is linked to the local variable in the procedure. Each \fIvarName\fR argument
must not have any namespace separators in it. The result is the empty string.
.TP
\fIobj \fBvarname \fIvarName\fR
.
This method returns the globally qualified name of the variable \fIvarName\fR
in the unique namespace for the object \fIobj\fR.










.SH EXAMPLES
.PP
This example demonstrates basic use of an object.
.PP
.CS
set obj [\fBoo::object\fR new]
$obj foo             \fI\(-> error "unknown method foo"\fR







|



|
>
>
>
>
>
|
|
|













>
>
>
>
>
>
>
>
>
>







61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
.TP
\fIobj \fBeval\fR ?\fIarg ...\fR?
.
This method concatenates the arguments, \fIarg\fR, as if with \fBconcat\fR,
and then evaluates the resulting script in the namespace that is uniquely
associated with \fIobj\fR, returning the result of the evaluation.
.TP
\fIobj \fBunknown ?\fImethodName\fR? ?\fIarg ...\fR?
.
This method is called when an attempt to invoke the method \fImethodName\fR on
object \fIobj\fR fails. The arguments that the user supplied to the method are
given as \fIarg\fR arguments.
.VS
If \fImethodName\fR is absent, the object was invoked with no method name at
all (or any other arguments).
.VE
The default implementation (i.e., the one defined by the \fBoo::object\fR
class) generates a suitable error, detailing what methods the object supports
given whether the object was invoked by its public name or through the
\fBmy\fR command.
.TP
\fIobj \fBvariable \fR?\fIvarName ...\fR?
.
This method arranges for each variable called \fIvarName\fR to be linked from
the object \fIobj\fR's unique namespace into the caller's context. Thus, if it
is invoked from inside a procedure then the namespace variable in the object
is linked to the local variable in the procedure. Each \fIvarName\fR argument
must not have any namespace separators in it. The result is the empty string.
.TP
\fIobj \fBvarname \fIvarName\fR
.
This method returns the globally qualified name of the variable \fIvarName\fR
in the unique namespace for the object \fIobj\fR.
.TP
\fIobj \fB<cloned> \fIsourceObjectName\fR
.VS
This method is used by the \fBoo::object\fR command to copy the state of one
object to another. It is responsible for copying the procedures and variables
of the namespace of the source object (\fIsourceObjectName\fR) to the current
object. It does not copy any other types of commands or any traces on the
variables; that can be added if desired by overriding this method in a
subclass.
.VE
.SH EXAMPLES
.PP
This example demonstrates basic use of an object.
.PP
.CS
set obj [\fBoo::object\fR new]
$obj foo             \fI\(-> error "unknown method foo"\fR

Changes to doc/platform.n.

8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform ?1.0.4?\fR
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
\fBplatform::patterns \fIidentifier\fR
.fi
.BE
.SH DESCRIPTION







|







8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
.TH "platform" n 1.0.4 platform "Tcl Bundled Packages"
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
platform \- System identification support code and utilities
.SH SYNOPSIS
.nf
\fBpackage require platform ?1.0.10?\fR
.sp
\fBplatform::generic\fR
\fBplatform::identify\fR
\fBplatform::patterns \fIidentifier\fR
.fi
.BE
.SH DESCRIPTION
41
42
43
44
45
46
47

48
49
50
51
52
53
54
55

56
57
58
59
60
61

62
63
64














65
66



The \fBplatform\fR package prevents such fragmentation - i.e., it
establishes a standard naming convention for architectures running Tcl
and makes it more convenient for developers to identify the current
architecture a Tcl program is running on.
.SH COMMANDS
.TP
\fBplatform::identify\fR

This command returns an identifier describing the platform the Tcl
core is running on. The returned identifier has the general format
\fIOS\fR-\fICPU\fR. The \fIOS\fR part of the identifier may contain
details like kernel version, libc version, etc., and this information
may contain dashes as well.  The \fICPU\fR part will not contain
dashes, making the preceding dash the last dash in the result.
.TP
\fBplatform::generic\fR

This command returns a simplified identifier describing the platform
the Tcl core is running on. In contrast to \fBplatform::identify\fR it
leaves out details like kernel version, libc version, etc. The
returned identifier has the general format \fIOS\fR-\fICPU\fR.
.TP
\fBplatform::patterns 	\fIidentifier\fR

This command takes an identifier as returned by
\fBplatform::identify\fR and returns a list of identifiers describing
compatible architectures.














.SH KEYWORDS
operating system, cpu architecture, platform, architecture










>








>





|
>



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


>
>
>
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
The \fBplatform\fR package prevents such fragmentation - i.e., it
establishes a standard naming convention for architectures running Tcl
and makes it more convenient for developers to identify the current
architecture a Tcl program is running on.
.SH COMMANDS
.TP
\fBplatform::identify\fR
.
This command returns an identifier describing the platform the Tcl
core is running on. The returned identifier has the general format
\fIOS\fR-\fICPU\fR. The \fIOS\fR part of the identifier may contain
details like kernel version, libc version, etc., and this information
may contain dashes as well.  The \fICPU\fR part will not contain
dashes, making the preceding dash the last dash in the result.
.TP
\fBplatform::generic\fR
.
This command returns a simplified identifier describing the platform
the Tcl core is running on. In contrast to \fBplatform::identify\fR it
leaves out details like kernel version, libc version, etc. The
returned identifier has the general format \fIOS\fR-\fICPU\fR.
.TP
\fBplatform::patterns \fIidentifier\fR
.
This command takes an identifier as returned by
\fBplatform::identify\fR and returns a list of identifiers describing
compatible architectures.
.SH EXAMPLE
.PP
This can be used to allow an application to be shipped with multiple builds of
a shared library, so that the same package works on many versions of an
operating system. For example:
.PP
.CS
\fBpackage require platform\fR
# Assume that app script is .../theapp/bin/theapp.tcl
set binDir [file dirname [file normalize [info script]]]
set libDir [file join $binDir .. lib]
set platLibDir [file join $libDir [\fBplatform::identify\fR]]
load [file join $platLibDir support[info sharedlibextension]]
.CE
.SH KEYWORDS
operating system, cpu architecture, platform, architecture
'\" Local Variables:
'\" mode: nroff
'\" End:

Changes to doc/proc.n.

49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
actual arguments.  
Arguments with default values that are followed by non-defaulted
arguments become required arguments (in 8.6 it will be considered an 
error).
There is one special case to permit procedures with
variable numbers of arguments.  If the last formal argument has the name
\fBargs\fR, then a call to the procedure may contain more actual arguments
than the procedure has formals.  In this case, all of the actual arguments
starting at the one that would be assigned to \fBargs\fR are combined into
a list (as if the \fBlist\fR command had been used); this combined value
is assigned to the local variable \fBargs\fR.
.PP
When \fIbody\fR is being executed, variable names normally refer to
local variables, which are created automatically when referenced and
deleted when the procedure returns.  One local variable is automatically
created for each of the procedure's arguments.
Other variables can only be accessed by invoking one of the \fBglobal\fR, 
\fBvariable\fR, \fBupvar\fR or \fBnamespace upvar\fR commands.
The current namespace when \fIbody\fR is executed will be the
namespace that the procedure's name exists in, which will be the
namespace that itwas created in unless it has been changed with
\fBrename\fR.
'\" We may change this! It makes [variable] unstable when renamed and is
'\" frankly pretty crazy, but doing it right is harder than it looks.
.PP
The \fBproc\fR command returns an empty string.  When a procedure is
invoked, the procedure's return value is the value specified in a
\fBreturn\fR command.  If the procedure does not execute an explicit







|












|







49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
actual arguments.  
Arguments with default values that are followed by non-defaulted
arguments become required arguments (in 8.6 it will be considered an 
error).
There is one special case to permit procedures with
variable numbers of arguments.  If the last formal argument has the name
\fBargs\fR, then a call to the procedure may contain more actual arguments
than the procedure has formal arguments.  In this case, all of the actual arguments
starting at the one that would be assigned to \fBargs\fR are combined into
a list (as if the \fBlist\fR command had been used); this combined value
is assigned to the local variable \fBargs\fR.
.PP
When \fIbody\fR is being executed, variable names normally refer to
local variables, which are created automatically when referenced and
deleted when the procedure returns.  One local variable is automatically
created for each of the procedure's arguments.
Other variables can only be accessed by invoking one of the \fBglobal\fR, 
\fBvariable\fR, \fBupvar\fR or \fBnamespace upvar\fR commands.
The current namespace when \fIbody\fR is executed will be the
namespace that the procedure's name exists in, which will be the
namespace that it was created in unless it has been changed with
\fBrename\fR.
'\" We may change this! It makes [variable] unstable when renamed and is
'\" frankly pretty crazy, but doing it right is harder than it looks.
.PP
The \fBproc\fR command returns an empty string.  When a procedure is
invoked, the procedure's return value is the value specified in a
\fBreturn\fR command.  If the procedure does not execute an explicit

Changes to doc/re_syntax.n.

174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
(inclusive) in the collating sequence, e.g.
.QW \fB[0\-9]\fR
in Unicode matches any conventional decimal digit. Two ranges may not share an
endpoint, so e.g.
.QW \fBa\-c\-e\fR
is illegal. Ranges in Tcl always use the
Unicode collating sequence, but other programs may use other collating
sequences and this can be a source of incompatability between programs.
.PP
To include a literal \fB]\fR or \fB\-\fR in the list, the simplest
method is to enclose it in \fB[.\fR and \fB.]\fR to make it a
collating element (see below). Alternatively, make it the first
character (following a possible
.QW \fB^\fR ),
or (AREs only) precede it with







|







174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
(inclusive) in the collating sequence, e.g.
.QW \fB[0\-9]\fR
in Unicode matches any conventional decimal digit. Two ranges may not share an
endpoint, so e.g.
.QW \fBa\-c\-e\fR
is illegal. Ranges in Tcl always use the
Unicode collating sequence, but other programs may use other collating
sequences and this can be a source of incompatibility between programs.
.PP
To include a literal \fB]\fR or \fB\-\fR in the list, the simplest
method is to enclose it in \fB[.\fR and \fB.]\fR to make it a
collating element (see below). Alternatively, make it the first
character (following a possible
.QW \fB^\fR ),
or (AREs only) precede it with
219
220
221
222
223
224
225
226

227
228
229
230
231
232
233
.IP \fBblank\fR 8
A space or tab character.
.IP \fBspace\fR 8
A character producing white space in displayed text.
.IP \fBpunct\fR 8
A punctuation character.
.IP \fBgraph\fR 8
A character with a visible representation (includes both alnum and punct).

.IP \fBcntrl\fR 8
A control character.
.PP
A locale may provide others. A character class may not be used as an endpoint
of a range.
.RS
.PP







|
>







219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
.IP \fBblank\fR 8
A space or tab character.
.IP \fBspace\fR 8
A character producing white space in displayed text.
.IP \fBpunct\fR 8
A punctuation character.
.IP \fBgraph\fR 8
A character with a visible representation (includes both \fBalnum\fR
and \fBpunct\fR).
.IP \fBcntrl\fR 8
A control character.
.PP
A locale may provide others. A character class may not be used as an endpoint
of a range.
.RS
.PP

Changes to doc/seek.n.

45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
the file or device.  A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
position after the end of file.
.PP
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
The command flushes all buffered output for the channel before the command
returns, even if the channel is in nonblocking mode.
It also discards any buffered and unread input.
This command returns an empty string.
An error occurs if this command is applied to channels whose underlying
file or device does not support seeking.
.PP
Note that \fIoffset\fR values are byte offsets, not character
offsets.  Both \fBseek\fR and \fBtell\fR operate in terms of bytes,







|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
the file or device.  A negative \fIoffset\fR places the access position
before the end of file, and a positive \fIoffset\fR places the access
position after the end of file.
.PP
The \fIorigin\fR argument defaults to \fBstart\fR.
.PP
The command flushes all buffered output for the channel before the command
returns, even if the channel is in non-blocking mode.
It also discards any buffered and unread input.
This command returns an empty string.
An error occurs if this command is applied to channels whose underlying
file or device does not support seeking.
.PP
Note that \fIoffset\fR values are byte offsets, not character
offsets.  Both \fBseek\fR and \fBtell\fR operate in terms of bytes,
82
83
84
85
86
87
88




set data [read $f 10]
close $f
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), tell(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, file, seek











>
>
>
>
82
83
84
85
86
87
88
89
90
91
92
set data [read $f 10]
close $f
.CE
.SH "SEE ALSO"
file(n), open(n), close(n), gets(n), tell(n), Tcl_StandardChannels(3)
.SH KEYWORDS
access position, file, seek
'\" Local Variables:
'\" mode: nroff
'\" fill-column: 78
'\" End:

Changes to doc/self.n.

87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
When invoked from a method that is not at the end of a call chain (i.e. where
the \fBnext\fR command will invoke an actual method implementation), this
subcommand returns a two element list describing the next element in the
method call chain; the first element is the name of the class or object that
declares the next part of the call chain, and the second element is the name
of the method (with the strings \fB<constructor>\fR and \fB<destructor>\fR
indicating constructors and destructors respectively). If invoked from a
method that is at the end of a call chain, this subcommand returns the emtpy
string.
.TP
\fBself object\fR
.
This returns the name of the object that the method was invoked upon.
.TP
\fBself target\fR







|







87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
When invoked from a method that is not at the end of a call chain (i.e. where
the \fBnext\fR command will invoke an actual method implementation), this
subcommand returns a two element list describing the next element in the
method call chain; the first element is the name of the class or object that
declares the next part of the call chain, and the second element is the name
of the method (with the strings \fB<constructor>\fR and \fB<destructor>\fR
indicating constructors and destructors respectively). If invoked from a
method that is at the end of a call chain, this subcommand returns the empty
string.
.TP
\fBself object\fR
.
This returns the name of the object that the method was invoked upon.
.TP
\fBself target\fR

Changes to doc/socket.n.

68
69
70
71
72
73
74
75

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
.TP
\fB\-async\fR
.
This option will cause the client socket to be connected
asynchronously. This means that the socket will be created immediately
but may not yet be connected to the server, when the call to
\fBsocket\fR returns.


When a \fBgets\fR or \fBflush\fR is done on the socket before the
connection attempt succeeds or fails, if the socket is in blocking
mode, the operation will wait until the connection is completed or
fails. If the socket is in nonblocking mode and a \fBgets\fR or
\fBflush\fR is done on the socket before the connection attempt
succeeds or fails, the operation returns immediately and
\fBfblocked\fR on the socket returns 1. Synchronous client sockets may
be switched (after they have connected) to operating in asynchronous
mode using:
.RS
.PP
.CS
\fBchan configure \fIchan \fB\-blocking 0\fR
.CE
.PP
See the \fBchan configure\fR command for more details.

The Tcl event loop should be running while an asynchronous connection
is in progress, because it may have to do several connection attempts
in the background. Runnig the event loop also allows you to set up a
writable channel event on the socket to get notified when the
asyncronous connection has succeeded or failed. See the \fBvwait\fR
and the \fBchan\fR comands for more details on the event loop and
channel events.

.RE
.SH "SERVER SOCKETS"
.PP
If the \fB\-server\fR option is specified then the new socket will be
a server that listens on the given \fIport\fR (either an integer or a
service name, where supported and understood by the host operating
system; if \fIport\fR is zero, the operating system will allocate a







|
>









<






|


|

|
|

<







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85

86
87
88
89
90
91
92
93
94
95
96
97
98
99

100
101
102
103
104
105
106
.TP
\fB\-async\fR
.
This option will cause the client socket to be connected
asynchronously. This means that the socket will be created immediately
but may not yet be connected to the server, when the call to
\fBsocket\fR returns.
.RS
.PP
When a \fBgets\fR or \fBflush\fR is done on the socket before the
connection attempt succeeds or fails, if the socket is in blocking
mode, the operation will wait until the connection is completed or
fails. If the socket is in nonblocking mode and a \fBgets\fR or
\fBflush\fR is done on the socket before the connection attempt
succeeds or fails, the operation returns immediately and
\fBfblocked\fR on the socket returns 1. Synchronous client sockets may
be switched (after they have connected) to operating in asynchronous
mode using:

.PP
.CS
\fBchan configure \fIchan \fB\-blocking 0\fR
.CE
.PP
See the \fBchan configure\fR command for more details.
.PP
The Tcl event loop should be running while an asynchronous connection
is in progress, because it may have to do several connection attempts
in the background. Running the event loop also allows you to set up a
writable channel event on the socket to get notified when the
asynchronous connection has succeeded or failed. See the \fBvwait\fR
and the \fBchan\fR commands for more details on the event loop and
channel events.

.RE
.SH "SERVER SOCKETS"
.PP
If the \fB\-server\fR option is specified then the new socket will be
a server that listens on the given \fIport\fR (either an integer or a
service name, where supported and understood by the host operating
system; if \fIport\fR is zero, the operating system will allocate a
153
154
155
156
157
158
159
160

161
162

163
164
165
166
167
168
169
170
171

172
173
174
175
176
177
178
179
180
181
182
183
184
185
.TP
\fB\-error\fR
.
This option gets the current error status of the given socket.  This
is useful when you need to determine if an asynchronous connect
operation succeeded.  If there was an error, the error message is
returned.  If there was no error, an empty string is returned.


Note that the error status is reset by the read operation; this mimics
the underlying getsockopt(SO_ERROR) call.

.TP
\fB\-sockname\fR
.
For client sockets (including the channels that get created when a
client connects to a server socket) this option returns a list of
three elements, the address, the host name and the port number for the
socket. If the host name cannot be computed, the second element is
identical to the address, the first element of the list.


For server sockets this option returns a list of a multiple of three
elements each group of which have the same meaning as described
above. The list contains more than one group when the server socket
was created without \fB\-myaddr\fR or with the argument to
\fB\-myaddr\fR being a domain name that resolves multiple IP addresses
that are local to the invoking host.

.TP
\fB\-peername\fR
.
This option is not supported by server sockets. For client and accepted
sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the







|
>


>








|
>






|







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
.TP
\fB\-error\fR
.
This option gets the current error status of the given socket.  This
is useful when you need to determine if an asynchronous connect
operation succeeded.  If there was an error, the error message is
returned.  If there was no error, an empty string is returned.
.RS
.PP
Note that the error status is reset by the read operation; this mimics
the underlying getsockopt(SO_ERROR) call.
.RE
.TP
\fB\-sockname\fR
.
For client sockets (including the channels that get created when a
client connects to a server socket) this option returns a list of
three elements, the address, the host name and the port number for the
socket. If the host name cannot be computed, the second element is
identical to the address, the first element of the list.
.RS
.PP
For server sockets this option returns a list of a multiple of three
elements each group of which have the same meaning as described
above. The list contains more than one group when the server socket
was created without \fB\-myaddr\fR or with the argument to
\fB\-myaddr\fR being a domain name that resolves multiple IP addresses
that are local to the invoking host.
.RE
.TP
\fB\-peername\fR
.
This option is not supported by server sockets. For client and accepted
sockets, this option returns a list of three elements; these are the
address, the host name and the port to which the peer socket is connected
or bound. If the host name cannot be computed, the second element of the

Changes to doc/string.n.

117
118
119
120
121
122
123






124
125
126
127
128
129
130
.IP \fBdigit\fR 12
Any Unicode digit character.  Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the valid forms for a double in Tcl, with optional surrounding
whitespace.  In case of under/overflow in the value, 0 is returned and
the \fIvarname\fR will contain \-1.






.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
.IP \fBgraph\fR 12
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for a 32-bit integer value in Tcl,







>
>
>
>
>
>







117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
.IP \fBdigit\fR 12
Any Unicode digit character.  Note that this includes characters
outside of the [0\-9] range.
.IP \fBdouble\fR 12
Any of the valid forms for a double in Tcl, with optional surrounding
whitespace.  In case of under/overflow in the value, 0 is returned and
the \fIvarname\fR will contain \-1.
.IP \fBentier\fR 12
.VS 8.6
Any of the valid string formats for an integer value of arbitrary size
in Tcl, with optional surrounding whitespace. The formats accepted are
exactly those accepted by the C routine \fBTcl_GetBignumFromObj\fR.
.VE
.IP \fBfalse\fR 12
Any of the forms allowed to \fBTcl_GetBoolean\fR where the value is
false.
.IP \fBgraph\fR 12
Any Unicode printing character, except space.
.IP \fBinteger\fR 12
Any of the valid string formats for a 32-bit integer value in Tcl,

Changes to generic/tcl.decls.

770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
}
declare 216 {
    void Tcl_Release(ClientData clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 generic {
    int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 generic {
    int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 {
    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 {







|


|







770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
}
declare 216 {
    void Tcl_Release(ClientData clientData)
}
declare 217 {
    void Tcl_ResetResult(Tcl_Interp *interp)
}
declare 218 {
    int Tcl_ScanElement(const char *src, int *flagPtr)
}
declare 219 {
    int Tcl_ScanCountedElement(const char *src, int length, int *flagPtr)
}
# Obsolete
declare 220 {
    int Tcl_SeekOld(Tcl_Channel chan, int offset, int mode)
}
declare 221 {
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
# TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk
declare 627 {
    int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
		     const char *const symv[], int flags, void *procPtrs,
		     Tcl_LoadHandle *handlePtr)
}
declare 628 {
    void* Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
			 const char *symbol)
}
declare 629 {
    int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #







|







2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
# TIP #357 (Export TclLoadFile and TclpFindSymbol) kbk
declare 627 {
    int Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
		     const char *const symv[], int flags, void *procPtrs,
		     Tcl_LoadHandle *handlePtr)
}
declare 628 {
    void *Tcl_FindSymbol(Tcl_Interp *interp, Tcl_LoadHandle handle,
			 const char *symbol)
}
declare 629 {
    int Tcl_FSUnloadFile(Tcl_Interp *interp, Tcl_LoadHandle handlePtr)
}

# ----- BASELINE -- FOR -- 8.6.0 ----- #
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}

################################
# Mac OS X specific functions

declare 0 macosx {
    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
	    const char *bundleName, int hasResourceFile,
	    int maxPathLen, char *libraryPath)
}
declare 1 macosx {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, int maxPathLen, char *libraryPath)
}

##############################################################################








|




|







2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
declare 1 win {
    char *Tcl_WinTCharToUtf(const TCHAR *str, int len, Tcl_DString *dsPtr)
}

################################
# Mac OS X specific functions

declare 0 {unix macosx} {
    int Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
	    const char *bundleName, int hasResourceFile,
	    int maxPathLen, char *libraryPath)
}
declare 1 {unix macosx} {
    int Tcl_MacOSXOpenVersionedBundleResources(Tcl_Interp *interp,
	    const char *bundleName, const char *bundleVersion,
	    int hasResourceFile, int maxPathLen, char *libraryPath)
}

##############################################################################

Changes to generic/tcl.h.

158
159
160
161
162
163
164

















165
166
167
168
169
170
171
#endif
#if defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
#else
#   define TCL_FORMAT_PRINTF(a,b)
#endif


















/*
 *----------------------------------------------------------------------------
 * Macros used to declare a function to be exported by a DLL. Used by Windows,
 * maps to no-op declarations on non-Windows systems. The default build on
 * windows is for a DLL, which causes the DLLIMPORT and DLLEXPORT macros to be
 * nonempty. To build a static library, the macro STATIC_BUILD should be
 * defined.







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







158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
#endif
#if defined(__GNUC__) && (__GNUC__ > 2)
#   define TCL_FORMAT_PRINTF(a,b) __attribute__ ((__format__ (__printf__, a, b)))
#else
#   define TCL_FORMAT_PRINTF(a,b)
#endif

/*
 * Allow a part of Tcl's API to be explicitly marked as deprecated.
 *
 * Used to make TIP 330/336 generate moans even if people use the
 * compatibility macros. Change your code, guys! We won't support you forever.
 */

#if defined(__GNUC__) && ((__GNUC__ >= 4) || ((__GNUC__ == 3) && (__GNUC_MINOR__ >= 1)))
#   if (__GNUC__ > 4) || ((__GNUC__ == 4) && (__GNUC__MINOR__ >= 5))
#	define TCL_DEPRECATED_API(msg)	__attribute__ ((__deprecated__ (msg)))
#   else
#	define TCL_DEPRECATED_API(msg)	__attribute__ ((__deprecated__))
#   endif
#else
#   define TCL_DEPRECATED_API(msg)	/* nothing portable */
#endif

/*
 *----------------------------------------------------------------------------
 * Macros used to declare a function to be exported by a DLL. Used by Windows,
 * maps to no-op declarations on non-Windows systems. The default build on
 * windows is for a DLL, which causes the DLLIMPORT and DLLEXPORT macros to be
 * nonempty. To build a static library, the macro STATIC_BUILD should be
 * defined.
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
 *
 * Note on converting between Tcl_WideInt and strings. This implementation (in
 * tclObj.c) depends on the function
 * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
 */

#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
#   if defined(__WIN32__) && !defined(__CYGWIN__)
#      define TCL_WIDE_INT_TYPE __int64
#      ifdef __BORLANDC__
typedef struct stati64 Tcl_StatBuf;
#         define TCL_LL_MODIFIER	"L"
#      else /* __BORLANDC__ */
#         if defined(_WIN64)
typedef struct __stat64 Tcl_StatBuf;
#         elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
typedef struct _stati64	Tcl_StatBuf;
#         else
typedef struct _stat32i64 Tcl_StatBuf;
#         endif /* _MSC_VER < 1400 */
#         define TCL_LL_MODIFIER	"I64"
#      endif /* __BORLANDC__ */
#   elif defined(__GNUC__)
#      define TCL_WIDE_INT_TYPE long long
#      define TCL_LL_MODIFIER	"ll"
#      if defined(__WIN32__)
typedef struct _stat32i64 Tcl_StatBuf;
#      else
typedef struct stat	Tcl_StatBuf;
#      endif
#   else /* ! __WIN32__ && ! __GNUC__ */
/*
 * Don't know what platform it is and configure hasn't discovered what is
 * going on for us. Try to guess...
 */
#      ifdef NO_LIMITS_H
#	  error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG







|


<


<
<
<
<
<
<
<





<
<
<
<
<







386
387
388
389
390
391
392
393
394
395

396
397







398
399
400
401
402





403
404
405
406
407
408
409
 *
 * Note on converting between Tcl_WideInt and strings. This implementation (in
 * tclObj.c) depends on the function
 * sprintf(...,"%" TCL_LL_MODIFIER "d",...).
 */

#if !defined(TCL_WIDE_INT_TYPE)&&!defined(TCL_WIDE_INT_IS_LONG)
#   if defined(__WIN32__)
#      define TCL_WIDE_INT_TYPE __int64
#      ifdef __BORLANDC__

#         define TCL_LL_MODIFIER	"L"
#      else /* __BORLANDC__ */







#         define TCL_LL_MODIFIER	"I64"
#      endif /* __BORLANDC__ */
#   elif defined(__GNUC__)
#      define TCL_WIDE_INT_TYPE long long
#      define TCL_LL_MODIFIER	"ll"





#   else /* ! __WIN32__ && ! __GNUC__ */
/*
 * Don't know what platform it is and configure hasn't discovered what is
 * going on for us. Try to guess...
 */
#      ifdef NO_LIMITS_H
#	  error please define either TCL_WIDE_INT_TYPE or TCL_WIDE_INT_IS_LONG
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450

































451
452
453
454
455
456
457
#   define TCL_WIDE_INT_TYPE	long
#endif /* TCL_WIDE_INT_IS_LONG */

typedef TCL_WIDE_INT_TYPE		Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;

#ifdef TCL_WIDE_INT_IS_LONG
typedef struct stat	Tcl_StatBuf;
#   define Tcl_WideAsLong(val)		((long)(val))
#   define Tcl_LongAsWide(val)		((long)(val))
#   define Tcl_WideAsDouble(val)	((double)((long)(val)))
#   define Tcl_DoubleAsWide(val)	((long)((double)(val)))
#   ifndef TCL_LL_MODIFIER
#      define TCL_LL_MODIFIER		"l"
#   endif /* !TCL_LL_MODIFIER */
#else /* TCL_WIDE_INT_IS_LONG */
/*
 * The next short section of defines are only done when not running on Windows
 * or some other strange platform.
 */
#   ifndef TCL_LL_MODIFIER
#      ifdef HAVE_STRUCT_STAT64
typedef struct stat64	Tcl_StatBuf;
#      else
typedef struct stat	Tcl_StatBuf;
#      endif /* HAVE_STRUCT_STAT64 */
#      define TCL_LL_MODIFIER		"ll"
#   endif /* !TCL_LL_MODIFIER */
#   define Tcl_WideAsLong(val)		((long)((Tcl_WideInt)(val)))
#   define Tcl_LongAsWide(val)		((Tcl_WideInt)((long)(val)))
#   define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#   define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */


































/*
 *----------------------------------------------------------------------------
 * Data structures defined opaquely in this module. The definitions below just
 * provide dummy types. A few fields are made visible in Tcl_Interp
 * structures, namely those used for returning a string result from commands.
 * Direct access to the result field is discouraged in Tcl 8.0. The







<













<
<
<
<
<







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







422
423
424
425
426
427
428

429
430
431
432
433
434
435
436
437
438
439
440
441





442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
#   define TCL_WIDE_INT_TYPE	long
#endif /* TCL_WIDE_INT_IS_LONG */

typedef TCL_WIDE_INT_TYPE		Tcl_WideInt;
typedef unsigned TCL_WIDE_INT_TYPE	Tcl_WideUInt;

#ifdef TCL_WIDE_INT_IS_LONG

#   define Tcl_WideAsLong(val)		((long)(val))
#   define Tcl_LongAsWide(val)		((long)(val))
#   define Tcl_WideAsDouble(val)	((double)((long)(val)))
#   define Tcl_DoubleAsWide(val)	((long)((double)(val)))
#   ifndef TCL_LL_MODIFIER
#      define TCL_LL_MODIFIER		"l"
#   endif /* !TCL_LL_MODIFIER */
#else /* TCL_WIDE_INT_IS_LONG */
/*
 * The next short section of defines are only done when not running on Windows
 * or some other strange platform.
 */
#   ifndef TCL_LL_MODIFIER





#      define TCL_LL_MODIFIER		"ll"
#   endif /* !TCL_LL_MODIFIER */
#   define Tcl_WideAsLong(val)		((long)((Tcl_WideInt)(val)))
#   define Tcl_LongAsWide(val)		((Tcl_WideInt)((long)(val)))
#   define Tcl_WideAsDouble(val)	((double)((Tcl_WideInt)(val)))
#   define Tcl_DoubleAsWide(val)	((Tcl_WideInt)((double)(val)))
#endif /* TCL_WIDE_INT_IS_LONG */

#if defined(__WIN32__)
#   ifdef __BORLANDC__
	typedef struct stati64 Tcl_StatBuf;
#   elif defined(_WIN64)
	typedef struct __stat64 Tcl_StatBuf;
#   elif (defined(_MSC_VER) && (_MSC_VER < 1400)) || defined(_USE_32BIT_TIME_T)
	typedef struct _stati64	Tcl_StatBuf;
#   else
	typedef struct _stat32i64 Tcl_StatBuf;
#   endif /* _MSC_VER < 1400 */
#elif defined(__CYGWIN__)
    typedef struct _stat32i64 {
	dev_t st_dev;
	unsigned short st_ino;
	unsigned short st_mode;
	short st_nlink;
	short st_uid;
	short st_gid;
	/* Here is a 2-byte gap */
	dev_t st_rdev;
	/* Here is a 4-byte gap */
	long long st_size;
	struct {long tv_sec;} st_atim;
	struct {long tv_sec;} st_mtim;
	struct {long tv_sec;} st_ctim;
	/* Here is a 4-byte gap */
    } Tcl_StatBuf;
#elif defined(HAVE_STRUCT_STAT64)
    typedef struct stat64 Tcl_StatBuf;
#else
    typedef struct stat Tcl_StatBuf;
#endif

/*
 *----------------------------------------------------------------------------
 * Data structures defined opaquely in this module. The definitions below just
 * provide dummy types. A few fields are made visible in Tcl_Interp
 * structures, namely those used for returning a string result from commands.
 * Direct access to the result field is discouraged in Tcl 8.0. The
469
470
471
472
473
474
475

476
477
478

479
480
481
482
483
484
485
486
487
488
489
490

491
492
493
494
495
496
497
498
499
500
501
502
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp {
    /* TIP #330: Strongly discourage extensions from using the string
     * result. */
#ifdef USE_INTERP_RESULT

    char *result;		/* If the last command returned a string
				 * result, this points to it. */
    void (*freeProc) (char *blockPtr);

				/* Zero means the string result is statically
				 * allocated. TCL_DYNAMIC means it was
				 * allocated with ckalloc and should be freed
				 * with ckfree. Other values give the address
				 * of function to invoke to free the result.
				 * Tcl_Eval must free it before executing next
				 * command. */
#else
    char *unused3;
    void (*unused4) (char *);
#endif
#ifdef USE_INTERP_ERRORLINE

    int errorLine;		/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
#else
    int unused5;
#endif
} Tcl_Interp;

typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;







>
|

|
>








|
|


>
|



|







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
533
534
535
536
 * accessed with Tcl_GetObjResult() and Tcl_SetObjResult().
 */

typedef struct Tcl_Interp {
    /* TIP #330: Strongly discourage extensions from using the string
     * result. */
#ifdef USE_INTERP_RESULT
    char *result TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
				/* If the last command returned a string
				 * result, this points to it. */
    void (*freeProc) (char *blockPtr)
	    TCL_DEPRECATED_API("use Tcl_GetResult/Tcl_SetResult");
				/* Zero means the string result is statically
				 * allocated. TCL_DYNAMIC means it was
				 * allocated with ckalloc and should be freed
				 * with ckfree. Other values give the address
				 * of function to invoke to free the result.
				 * Tcl_Eval must free it before executing next
				 * command. */
#else
    char *unused3 TCL_DEPRECATED_API("bad field access");
    void (*unused4) (char *) TCL_DEPRECATED_API("bad field access");
#endif
#ifdef USE_INTERP_ERRORLINE
    int errorLine TCL_DEPRECATED_API("use Tcl_GetErrorLine/Tcl_SetErrorLine");
				/* When TCL_ERROR is returned, this gives the
				 * line number within the command where the
				 * error occurred (1 if first line). */
#else
    int unused5 TCL_DEPRECATED_API("bad field access");
#endif
} Tcl_Interp;

typedef struct Tcl_AsyncHandler_ *Tcl_AsyncHandler;
typedef struct Tcl_Channel_ *Tcl_Channel;
typedef struct Tcl_ChannelTypeVersion_ *Tcl_ChannelTypeVersion;
typedef struct Tcl_Command_ *Tcl_Command;

Changes to generic/tclAlloc.c.

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
 */

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

#if USE_TCLALLOC

#ifdef TCL_DEBUG
#   define DEBUG
/* #define MSTATS */
#   define RCHECK
#endif

/*
 * We should really make use of AC_CHECK_TYPE(caddr_t) here, but it can wait
 * until Tcl uses config.h properly.
 */

#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;







<
<
<
<
<
<







22
23
24
25
26
27
28






29
30
31
32
33
34
35
 */

#include "tclInt.h"
#if !defined(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.
 */

#if defined(_MSC_VER) || defined(__MINGW32__) || defined(__BORLANDC__)
typedef unsigned long caddr_t;
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
    union overhead *next;		/* when free */
    unsigned char padding[TCL_ALLOCALIGN];	/* align struct to TCL_ALLOCALIGN bytes */
    struct {
	unsigned char magic0;		/* magic number */
	unsigned char index;		/* bucket # */
	unsigned char unused;		/* unused */
	unsigned char magic1;		/* other magic number */
#ifdef RCHECK
	unsigned short rmagic;		/* range magic number */
	unsigned long size;		/* actual block size */
	unsigned short unused2;		/* padding to 8-byte align */
#endif
    } ovu;
#define overMagic0	ovu.magic0
#define overMagic1	ovu.magic1
#define bucketIndex	ovu.index
#define rangeCheckMagic	ovu.rmagic
#define realBlockSize	ovu.size
};


#define MAGIC		0xef	/* magic # on accounting info */
#define RMAGIC		0x5555	/* magic # on range info */

#ifdef RCHECK
#define	RSLOP		sizeof(unsigned short)
#else
#define	RSLOP		0
#endif

#define OVERHEAD (sizeof(union overhead) + RSLOP)








|
















|







50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
    union overhead *next;		/* when free */
    unsigned char padding[TCL_ALLOCALIGN];	/* align struct to TCL_ALLOCALIGN bytes */
    struct {
	unsigned char magic0;		/* magic number */
	unsigned char index;		/* bucket # */
	unsigned char unused;		/* unused */
	unsigned char magic1;		/* other magic number */
#ifndef NDEBUG
	unsigned short rmagic;		/* range magic number */
	unsigned long size;		/* actual block size */
	unsigned short unused2;		/* padding to 8-byte align */
#endif
    } ovu;
#define overMagic0	ovu.magic0
#define overMagic1	ovu.magic1
#define bucketIndex	ovu.index
#define rangeCheckMagic	ovu.rmagic
#define realBlockSize	ovu.size
};


#define MAGIC		0xef	/* magic # on accounting info */
#define RMAGIC		0x5555	/* magic # on range info */

#ifndef NDEBUG
#define	RSLOP		sizeof(unsigned short)
#else
#define	RSLOP		0
#endif

#define OVERHEAD (sizeof(union overhead) + RSLOP)

138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
 * numMallocs[i] is the difference between the number of mallocs and frees for
 * a given block size.
 */

static	unsigned int numMallocs[NBUCKETS+1];
#endif

#if defined(DEBUG) || defined(RCHECK)
#define	ASSERT(p)	if (!(p)) Tcl_Panic(# p)
#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
#else
#define	ASSERT(p)
#define RANGE_ASSERT(p)
#endif








|







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
 * numMallocs[i] is the difference between the number of mallocs and frees for
 * a given block size.
 */

static	unsigned int numMallocs[NBUCKETS+1];
#endif

#if !defined(NDEBUG)
#define	ASSERT(p)	if (!(p)) Tcl_Panic(# p)
#define RANGE_ASSERT(p) if (!(p)) Tcl_Panic(# p)
#else
#define	ASSERT(p)
#define RANGE_ASSERT(p)
#endif

295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
	overPtr = (union overhead *) (bigBlockPtr + 1);
	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
	overPtr->bucketIndex = 0xff;
#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifdef RCHECK
	/*
	 * Record allocated size of block and bound space with magic numbers.
	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	overPtr->rangeCheckMagic = RMAGIC;
	BLOCK_END(overPtr) = RMAGIC;







|







289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
	overPtr = (union overhead *) (bigBlockPtr + 1);
	overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
	overPtr->bucketIndex = 0xff;
#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifndef NDEBUG
	/*
	 * Record allocated size of block and bound space with magic numbers.
	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	overPtr->rangeCheckMagic = RMAGIC;
	BLOCK_END(overPtr) = RMAGIC;
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
    overPtr->bucketIndex = (unsigned char) bucket;

#ifdef MSTATS
    numMallocs[bucket]++;
#endif

#ifdef RCHECK
    /*
     * Record allocated size of block and bound space with magic numbers.
     */

    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    overPtr->rangeCheckMagic = RMAGIC;
    BLOCK_END(overPtr) = RMAGIC;







|







347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
    overPtr->overMagic0 = overPtr->overMagic1 = MAGIC;
    overPtr->bucketIndex = (unsigned char) bucket;

#ifdef MSTATS
    numMallocs[bucket]++;
#endif

#ifndef NDEBUG
    /*
     * Record allocated size of block and bound space with magic numbers.
     */

    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    overPtr->rangeCheckMagic = RMAGIC;
    BLOCK_END(overPtr) = RMAGIC;
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587

	overPtr = (union overhead *) (bigBlockPtr + 1);

#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifdef RCHECK
	/*
	 * Record allocated size of block and update magic number bounds.
	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	BLOCK_END(overPtr) = RMAGIC;
#endif







|







567
568
569
570
571
572
573
574
575
576
577
578
579
580
581

	overPtr = (union overhead *) (bigBlockPtr + 1);

#ifdef MSTATS
	numMallocs[NBUCKETS]++;
#endif

#ifndef NDEBUG
	/*
	 * Record allocated size of block and update magic number bounds.
	 */

	overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
	BLOCK_END(overPtr) = RMAGIC;
#endif
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
	return newPtr;
    }

    /*
     * Ok, we don't have to copy, it fits as-is
     */

#ifdef RCHECK
    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    BLOCK_END(overPtr) = RMAGIC;
#endif

    Tcl_MutexUnlock(allocMutexPtr);
    return(oldPtr);
}







|







609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
	return newPtr;
    }

    /*
     * Ok, we don't have to copy, it fits as-is
     */

#ifndef NDEBUG
    overPtr->realBlockSize = (numBytes + RSLOP - 1) & ~(RSLOP - 1);
    BLOCK_END(overPtr) = RMAGIC;
#endif

    Tcl_MutexUnlock(allocMutexPtr);
    return(oldPtr);
}

Changes to generic/tclBasic.c.

226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	1},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	1},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	1},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	1},
    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	1},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	1},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	1},
    {"lrange",		Tcl_LrangeObjCmd,	NULL,			NULL,	1},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
    {"lreplace",	Tcl_LreplaceObjCmd,	NULL,			NULL,	1},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},







|

|







226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
    {"join",		Tcl_JoinObjCmd,		NULL,			NULL,	1},
    {"lappend",		Tcl_LappendObjCmd,	TclCompileLappendCmd,	NULL,	1},
    {"lassign",		Tcl_LassignObjCmd,	TclCompileLassignCmd,	NULL,	1},
    {"lindex",		Tcl_LindexObjCmd,	TclCompileLindexCmd,	NULL,	1},
    {"linsert",		Tcl_LinsertObjCmd,	NULL,			NULL,	1},
    {"list",		Tcl_ListObjCmd,		TclCompileListCmd,	NULL,	1},
    {"llength",		Tcl_LlengthObjCmd,	TclCompileLlengthCmd,	NULL,	1},
    {"lrange",		Tcl_LrangeObjCmd,	TclCompileLrangeCmd,	NULL,	1},
    {"lrepeat",		Tcl_LrepeatObjCmd,	NULL,			NULL,	1},
    {"lreplace",	Tcl_LreplaceObjCmd,	TclCompileLreplaceCmd,	NULL,	1},
    {"lreverse",	Tcl_LreverseObjCmd,	NULL,			NULL,	1},
    {"lsearch",		Tcl_LsearchObjCmd,	NULL,			NULL,	1},
    {"lset",		Tcl_LsetObjCmd,		TclCompileLsetCmd,	NULL,	1},
    {"lsort",		Tcl_LsortObjCmd,	NULL,			NULL,	1},
    {"package",		Tcl_PackageObjCmd,	NULL,			NULL,	1},
    {"proc",		Tcl_ProcObjCmd,		NULL,			NULL,	1},
    {"regexp",		Tcl_RegexpObjCmd,	TclCompileRegexpCmd,	NULL,	1},
254
255
256
257
258
259
260

261
262
263
264
265
266
267
    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	1},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	1},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	1},
    {"yield",		NULL,			NULL,			TclNRYieldObjCmd,	1},


    /*
     * Commands in the OS-interface. Note that many of these are unsafe.
     */

    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	1},
    {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},







>







254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
    {"try",		Tcl_TryObjCmd,		TclCompileTryCmd,	TclNRTryObjCmd,	1},
    {"unset",		Tcl_UnsetObjCmd,	TclCompileUnsetCmd,	NULL,	1},
    {"uplevel",		Tcl_UplevelObjCmd,	NULL,			TclNRUplevelObjCmd,	1},
    {"upvar",		Tcl_UpvarObjCmd,	TclCompileUpvarCmd,	NULL,	1},
    {"variable",	Tcl_VariableObjCmd,	TclCompileVariableCmd,	NULL,	1},
    {"while",		Tcl_WhileObjCmd,	TclCompileWhileCmd,	TclNRWhileObjCmd,	1},
    {"yield",		NULL,			NULL,			TclNRYieldObjCmd,	1},
    {"yieldto",		NULL,			NULL,			TclNRYieldToObjCmd,	1},

    /*
     * Commands in the OS-interface. Note that many of these are unsafe.
     */

    {"after",		Tcl_AfterObjCmd,	NULL,			NULL,	1},
    {"cd",		Tcl_CdObjCmd,		NULL,			NULL,	0},
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846

    /* Adding the bytecode assembler command */
    cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
            "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
            TclNRAssembleObjCmd, NULL, NULL);
    cmdPtr->compileProc = &TclCompileAssembleCmd;

    Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldTo", NULL,
	    TclNRYieldToObjCmd, NULL, NULL);
    Tcl_NRCreateCommand(interp, "::tcl::unsupported::yieldm", NULL,
	    TclNRYieldObjCmd, INT2PTR(CORO_ACTIVATE_YIELDM), NULL);
    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
	    NRCoroInjectObjCmd, NULL, NULL);
    
#ifdef USE_DTRACE
    /*
     * Register the tcl::dtrace command.
     */

    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */







<
<
<
<


|







827
828
829
830
831
832
833




834
835
836
837
838
839
840
841
842
843

    /* Adding the bytecode assembler command */
    cmdPtr = (Command *) Tcl_NRCreateCommand(interp,
            "::tcl::unsupported::assemble", Tcl_AssembleObjCmd,
            TclNRAssembleObjCmd, NULL, NULL);
    cmdPtr->compileProc = &TclCompileAssembleCmd;





    Tcl_NRCreateCommand(interp, "::tcl::unsupported::inject", NULL,
	    NRCoroInjectObjCmd, NULL, NULL);

#ifdef USE_DTRACE
    /*
     * Register the tcl::dtrace command.
     */

    Tcl_CreateObjCommand(interp, "::tcl::dtrace", DTraceObjCmd, NULL, NULL);
#endif /* USE_DTRACE */
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
    cmdPtr->objProc = NULL;

    /*
     * Now free the Command structure, unless there is another reference to it
     * from a CmdName Tcl object in some ByteCode code sequence. In that case,
     * delay the cleanup until all references are either discarded (when a
     * ByteCode is freed) or replaced by a new reference (when a cached
     * CmdName Command reference is found to be invalid and TclNRExecuteByteCode
     * looks up the command in the command hashtable).
     */

    TclCleanupCommandMacro(cmdPtr);
    return 0;
}

/*







|
|







3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
    cmdPtr->objProc = NULL;

    /*
     * Now free the Command structure, unless there is another reference to it
     * from a CmdName Tcl object in some ByteCode code sequence. In that case,
     * delay the cleanup until all references are either discarded (when a
     * ByteCode is freed) or replaced by a new reference (when a cached
     * CmdName Command reference is found to be invalid and
     * TclNRExecuteByteCode looks up the command in the command hashtable).
     */

    TclCleanupCommandMacro(cmdPtr);
    return 0;
}

/*
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327

    if (cmdPtr->nreProc) {
        TclNRAddCallback(interp, NRRunObjProc, cmdPtr,
                INT2PTR(objc), (ClientData) objv, NULL);
        return TCL_OK;
    } else {
	return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
    }        
}

void
TclPushTailcallPoint(
    Tcl_Interp *interp)
{
    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);







|







4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324

    if (cmdPtr->nreProc) {
        TclNRAddCallback(interp, NRRunObjProc, cmdPtr,
                INT2PTR(objc), (ClientData) objv, NULL);
        return TCL_OK;
    } else {
	return cmdPtr->objProc(cmdPtr->objClientData, interp, objc, objv);
    }
}

void
TclPushTailcallPoint(
    Tcl_Interp *interp)
{
    TclNRAddCallback(interp, NRCommand, NULL, NULL, NULL, NULL);
8343
8344
8345
8346
8347
8348
8349
8350
8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361

8362
8363
8364
8365
8366
8367
8368
     */

    if (objc > 1) {
        Tcl_Obj *listPtr, *nsObjPtr;
        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
        Tcl_Namespace *ns1Ptr;
        NRE_callback *tailcallPtr;
        
        listPtr = Tcl_NewListObj(objc-1, objv+1);
        Tcl_IncrRefCount(listPtr);

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
                || (nsPtr != ns1Ptr)) {
            Tcl_Panic("Tailcall failed to find the proper namespace");
        }
        Tcl_IncrRefCount(nsObjPtr);

        TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr, NULL, NULL);

        tailcallPtr = TOP_CB(interp);
        TOP_CB(interp) = tailcallPtr->nextPtr;
        iPtr->varFramePtr->tailcallPtr = tailcallPtr;
    }
    return TCL_RETURN;
}








|










|
>







8340
8341
8342
8343
8344
8345
8346
8347
8348
8349
8350
8351
8352
8353
8354
8355
8356
8357
8358
8359
8360
8361
8362
8363
8364
8365
8366
     */

    if (objc > 1) {
        Tcl_Obj *listPtr, *nsObjPtr;
        Tcl_Namespace *nsPtr = (Tcl_Namespace *) iPtr->varFramePtr->nsPtr;
        Tcl_Namespace *ns1Ptr;
        NRE_callback *tailcallPtr;

        listPtr = Tcl_NewListObj(objc-1, objv+1);
        Tcl_IncrRefCount(listPtr);

        nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
        if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
                || (nsPtr != ns1Ptr)) {
            Tcl_Panic("Tailcall failed to find the proper namespace");
        }
        Tcl_IncrRefCount(nsObjPtr);

        TclNRAddCallback(interp, NRTailcallEval, listPtr, nsObjPtr,
                NULL, NULL);
        tailcallPtr = TOP_CB(interp);
        TOP_CB(interp) = tailcallPtr->nextPtr;
        iPtr->varFramePtr->tailcallPtr = tailcallPtr;
    }
    return TCL_RETURN;
}

8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
8397
8398
    }

    if (result != TCL_OK) {
        /*
         * Tailcall execution was preempted, eg by an intervening catch or by
         * a now-gone namespace: cleanup and return.
         */
        
        TailcallCleanup(data, interp, result);
        return result;
    }

    /*
     * Perform the tailcall
     */







|







8382
8383
8384
8385
8386
8387
8388
8389
8390
8391
8392
8393
8394
8395
8396
    }

    if (result != TCL_OK) {
        /*
         * Tailcall execution was preempted, eg by an intervening catch or by
         * a now-gone namespace: cleanup and return.
         */

        TailcallCleanup(data, interp, result);
        return result;
    }

    /*
     * Perform the tailcall
     */
8467
8468
8469
8470
8471
8472
8473

8474
8475
8476
8477
8478
8479
8480
TclNRYieldObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetResult(interp, "yield can only be called in a coroutine",







>







8465
8466
8467
8468
8469
8470
8471
8472
8473
8474
8475
8476
8477
8478
8479
TclNRYieldObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    CoroutineData *corPtr = iPtr->execEnvPtr->corPtr;

    if (objc > 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "?returnValue?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetResult(interp, "yield can only be called in a coroutine",
8507
8508
8509
8510
8511
8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
8551
8552

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetResult(interp, "yieldTo can only be called in a coroutine",
		TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    /*
     * Add the tailcall in the caller env, then just yield.
     *
     * This is essentially code from TclNRTailcallObjCmd
     */

    listPtr = Tcl_NewListObj(objc-1, objv+1);
    Tcl_IncrRefCount(listPtr);

    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
    if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
	    || (nsPtr != ns1Ptr)) {
	Tcl_Panic("yieldTo failed to find the proper namespace");
    }
    Tcl_IncrRefCount(nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr,
	    NULL);
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(clientData, interp, 1, objv);
}

static int
YieldToCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)







|

















|












|







8506
8507
8508
8509
8510
8511
8512
8513
8514
8515
8516
8517
8518
8519
8520
8521
8522
8523
8524
8525
8526
8527
8528
8529
8530
8531
8532
8533
8534
8535
8536
8537
8538
8539
8540
8541
8542
8543
8544
8545
8546
8547
8548
8549
8550
8551

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "command ?arg ...?");
	return TCL_ERROR;
    }

    if (!corPtr) {
	Tcl_SetResult(interp, "yieldto can only be called in a coroutine",
		TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ILLEGAL_YIELD", NULL);
	return TCL_ERROR;
    }

    /*
     * Add the tailcall in the caller env, then just yield.
     *
     * This is essentially code from TclNRTailcallObjCmd
     */

    listPtr = Tcl_NewListObj(objc-1, objv+1);
    Tcl_IncrRefCount(listPtr);

    nsObjPtr = Tcl_NewStringObj(nsPtr->fullName, -1);
    if ((TCL_OK != TclGetNamespaceFromObj(interp, nsObjPtr, &ns1Ptr))
	    || (nsPtr != ns1Ptr)) {
	Tcl_Panic("yieldto failed to find the proper namespace");
    }
    Tcl_IncrRefCount(nsObjPtr);

    /*
     * Add the callback in the caller's env, then instruct TEBC to yield.
     */

    iPtr->execEnvPtr = corPtr->callerEEPtr;
    TclNRAddCallback(interp, YieldToCallback, corPtr, listPtr, nsObjPtr,
	    NULL);
    iPtr->execEnvPtr = corPtr->eePtr;

    return TclNRYieldObjCmd(INT2PTR(CORO_ACTIVATE_YIELDM), interp, 1, objv);
}

static int
YieldToCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
8650
	ckfree(corPtr);
	return result;
    }

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    
    if (cmdPtr->flags & CMD_IS_DELETED) {
	/*
	 * The command was deleted while it was running: wind down the
	 * execEnv, this will do the complete cleanup. RewindCoroutine will
	 * restore both the caller's context and interp state.
	 */








|







8635
8636
8637
8638
8639
8640
8641
8642
8643
8644
8645
8646
8647
8648
8649
	ckfree(corPtr);
	return result;
    }

    NRE_ASSERT(COR_IS_SUSPENDED(corPtr));
    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);

    if (cmdPtr->flags & CMD_IS_DELETED) {
	/*
	 * The command was deleted while it was running: wind down the
	 * execEnv, this will do the complete cleanup. RewindCoroutine will
	 * restore both the caller's context and interp state.
	 */

8698
8699
8700
8701
8702
8703
8704
8705
8706


8707
8708
8709

8710
8711
8712
8713
8714



8715
8716
8717
8718
8719
8720
8721
8722
8723
8724
8725
8726
8727
8728
8729
8730
8731

8732
8733
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744
8745
8746
8747
8748
8749
8750
8751
8752
8753
8754
8755
8756
8757
8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
8769
8770
8771
8772
8773
8774
8775
8776
8777
8778
8779
8780
8781


8782
8783
8784


8785






8786
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810



8811
8812
8813
8814
8815

8816

8817
8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832
8833
8834
8835
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    iPtr->numLevels++;

    return result;
}


/*


 * NRCoroutineActivateCallback --
 *
 * This is the workhorse for coroutines: it implements both yield and resume.

 *
 * It is important that both be implemented in the same callback: the
 * detection of the impossibility to suspend due to a busy C-stack relies on
 * the precise position of a local variable in the stack. We do not want the
 * compiler to play tricks on us, either by moving things around or inlining.



 */

static int
NRCoroutineActivateCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    int type = PTR2INT(data[1]);
    int numLevels, unused;
    int *stackLevel = &unused;

    if (!corPtr->stackLevel) {
        /*
         * -- Coroutine is suspended --
         * Push the callback to restore the caller's context on yield or return

         */

        TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr, NULL, NULL,
                NULL);

        /*
         * Record the stackLevel at which the resume is happening, then swap
         * the interp's environment to make it suitable to run this
         * coroutine. 
         */
        
        corPtr->stackLevel = stackLevel;
        numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = iPtr->numLevels;

        SAVE_CONTEXT(corPtr->caller);
        corPtr->callerEEPtr = iPtr->execEnvPtr;
        RESTORE_CONTEXT(corPtr->running);
        iPtr->execEnvPtr = corPtr->eePtr;
        iPtr->numLevels += numLevels;
        
        return TCL_OK;
    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != stackLevel) {
            Tcl_SetResult(interp, "cannot yield: C stack busy",
                    TCL_STATIC);
            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
                    NULL);
            return TCL_ERROR;
        }
        
        if (type == CORO_ACTIVATE_YIELD) { 
            corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
        } else if (type == CORO_ACTIVATE_YIELDM) {
            corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
        } else {
            Tcl_Panic("Yield received an option which is not implemented");
        }
        
        corPtr->stackLevel = NULL;

        numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

        iPtr->execEnvPtr = corPtr->callerEEPtr;


        return TCL_OK;
    }
}










static int
NRCoroInjectObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;
    
    /*
     * Usage more or less like tailcall:
     *   inject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) {
        Tcl_SetObjResult(interp, Tcl_NewStringObj("can only inject a command into a coroutine", -1));



        return TCL_ERROR;
    }

    corPtr = (CoroutineData *) cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {

        Tcl_SetObjResult(interp, Tcl_NewStringObj("can only inject a command into a suspended coroutine", -1));

        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed
     */
    
    iPtr->execEnvPtr = corPtr->eePtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);    
    iPtr->execEnvPtr = savedEEPtr;
    
    return TCL_OK;
}

int
NRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */







<

>
>


|
>

|
|
|
|
>
>
>
















|
>


|
|



|
<

|









<
<












|
|






|







>
>
|
|
|
>
>
|
>
>
>
>
>
>











|












|
>
>
>



|

>
|
>





|

|

|

|







8697
8698
8699
8700
8701
8702
8703

8704
8705
8706
8707
8708
8709
8710
8711
8712
8713
8714
8715
8716
8717
8718
8719
8720
8721
8722
8723
8724
8725
8726
8727
8728
8729
8730
8731
8732
8733
8734
8735
8736
8737
8738
8739
8740
8741
8742
8743
8744

8745
8746
8747
8748
8749
8750
8751
8752
8753
8754
8755


8756
8757
8758
8759
8760
8761
8762
8763
8764
8765
8766
8767
8768
8769
8770
8771
8772
8773
8774
8775
8776
8777
8778
8779
8780
8781
8782
8783
8784
8785
8786
8787
8788
8789
8790
8791
8792
8793
8794
8795
8796
8797
8798
8799
8800
8801
8802
8803
8804
8805
8806
8807
8808
8809
8810
8811
8812
8813
8814
8815
8816
8817
8818
8819
8820
8821
8822
8823
8824
8825
8826
8827
8828
8829
8830
8831
8832
8833
8834
8835
8836
8837
8838
8839
8840
8841
8842
8843
8844
8845
8846
8847
8848
8849
8850
8851
8852
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    iPtr->numLevels++;

    return result;
}


/*
 *----------------------------------------------------------------------
 *
 * NRCoroutineActivateCallback --
 *
 *      This is the workhorse for coroutines: it implements both yield and
 *      resume.
 *
 *      It is important that both be implemented in the same callback: the
 *      detection of the impossibility to suspend due to a busy C-stack relies
 *      on the precise position of a local variable in the stack. We do not
 *      want the compiler to play tricks on us, either by moving things around
 *      or inlining.
 *
 *----------------------------------------------------------------------
 */

static int
NRCoroutineActivateCallback(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CoroutineData *corPtr = data[0];
    int type = PTR2INT(data[1]);
    int numLevels, unused;
    int *stackLevel = &unused;

    if (!corPtr->stackLevel) {
        /*
         * -- Coroutine is suspended --
         * Push the callback to restore the caller's context on yield or
         * return.
         */

        TclNRAddCallback(interp, NRCoroutineCallerCallback, corPtr,
                NULL, NULL, NULL);

        /*
         * Record the stackLevel at which the resume is happening, then swap
         * the interp's environment to make it suitable to run this coroutine.

         */

        corPtr->stackLevel = stackLevel;
        numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = iPtr->numLevels;

        SAVE_CONTEXT(corPtr->caller);
        corPtr->callerEEPtr = iPtr->execEnvPtr;
        RESTORE_CONTEXT(corPtr->running);
        iPtr->execEnvPtr = corPtr->eePtr;
        iPtr->numLevels += numLevels;


    } else {
        /*
         * Coroutine is active: yield
         */

        if (corPtr->stackLevel != stackLevel) {
            Tcl_SetResult(interp, "cannot yield: C stack busy",
                    TCL_STATIC);
            Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "CANT_YIELD",
                    NULL);
            return TCL_ERROR;
        }

        if (type == CORO_ACTIVATE_YIELD) {
            corPtr->nargs = COROUTINE_ARGUMENTS_SINGLE_OPTIONAL;
        } else if (type == CORO_ACTIVATE_YIELDM) {
            corPtr->nargs = COROUTINE_ARGUMENTS_ARBITRARY;
        } else {
            Tcl_Panic("Yield received an option which is not implemented");
        }

        corPtr->stackLevel = NULL;

        numLevels = iPtr->numLevels;
        iPtr->numLevels = corPtr->auxNumLevels;
        corPtr->auxNumLevels = numLevels - corPtr->auxNumLevels;

        iPtr->execEnvPtr = corPtr->callerEEPtr;
    }

    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * NRCoroInjectObjCmd --
 *
 *      Implementation of [::tcl::unsupported::inject] command.
 *
 *----------------------------------------------------------------------
 */

static int
NRCoroInjectObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const objv[])
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    ExecEnv *savedEEPtr = iPtr->execEnvPtr;

    /*
     * Usage more or less like tailcall:
     *   inject coroName cmd ?arg1 arg2 ...?
     */

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "coroName cmd ?arg1 arg2 ...?");
	return TCL_ERROR;
    }

    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, objv[1]);
    if ((!cmdPtr) || (cmdPtr->nreProc != NRInterpCoroutine)) {
        Tcl_AppendResult(interp, "can only inject a command into a coroutine",
                NULL);
        Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "COROUTINE",
                TclGetString(objv[1]), NULL);
        return TCL_ERROR;
    }

    corPtr = cmdPtr->objClientData;
    if (!COR_IS_SUSPENDED(corPtr)) {
        Tcl_AppendResult(interp,
                "can only inject a command into a suspended coroutine", NULL);
        Tcl_SetErrorCode(interp, "TCL", "COROUTINE", "ACTIVE", NULL);
        return TCL_ERROR;
    }

    /*
     * Add the callback to the coro's execEnv, so that it is the first thing
     * to happen when the coro is resumed.
     */

    iPtr->execEnvPtr = corPtr->eePtr;
    TclNREvalObjEx(interp, Tcl_NewListObj(objc-2, objv+2), 0, NULL, INT_MIN);
    iPtr->execEnvPtr = savedEEPtr;

    return TCL_OK;
}

int
NRInterpCoroutine(
    ClientData clientData,
    Tcl_Interp *interp,		/* Current interpreter. */
8878
8879
8880
8881
8882
8883
8884











8885
8886
8887
8888
8889
8890
8891
8892
8893
8894
8895
8896
8897
8898
8899
8900
8901
8902
8903
8904
8905
    }

    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);
    return TCL_OK;
}












int
TclNRCoroutineObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *fullName, *procName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_DString ds;
    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;
    
    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have







>
>
>
>
>
>
>
>
>
>
>













|







8895
8896
8897
8898
8899
8900
8901
8902
8903
8904
8905
8906
8907
8908
8909
8910
8911
8912
8913
8914
8915
8916
8917
8918
8919
8920
8921
8922
8923
8924
8925
8926
8927
8928
8929
8930
8931
8932
8933
    }

    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclNRCoroutineObjCmd --
 *
 *      Implementation of [coroutine] command; see documentation for
 *      description of what this does.
 *
 *----------------------------------------------------------------------
 */

int
TclNRCoroutineObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{
    Command *cmdPtr;
    CoroutineData *corPtr;
    const char *fullName, *procName;
    Namespace *nsPtr, *altNsPtr, *cxtNsPtr;
    Tcl_DString ds;
    Namespace *lookupNsPtr = iPtr->varFramePtr->nsPtr;

    if (objc < 3) {
	Tcl_WrongNumArgs(interp, 1, objv, "name cmd ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * FIXME: this is copy/pasted from Tcl_ProcObjCommand. Should have
8987
8988
8989
8990
8991
8992
8993
8994
8995
8996
8997
8998
8999
9000
9001
9002
9003
9004
9005
9006
9007
9008
9009
9010
9011
9012
9013
9014
9015
9016
9017
9018
9019
9020
9021
9022
9023
9024
9025
    corPtr->running.framePtr = iPtr->rootFramePtr;
    corPtr->running.varFramePtr = iPtr->rootFramePtr;
    corPtr->running.cmdFramePtr = NULL;
    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
    corPtr->stackLevel = NULL;
    corPtr->auxNumLevels = 0;
    iPtr->numLevels--;
    
    /*
     * Create the coro's execEnv, switch to it to push the exit and coro
     * command callbacks, then switch back. 
     */

    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    corPtr->eePtr->corPtr = corPtr;
    
    SAVE_CONTEXT(corPtr->caller);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;

    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
	    NULL, NULL, NULL);

    iPtr->lookupNsPtr = lookupNsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;
    
    /*
     * Now just resume the coroutine. Take care to insure that the command is
     * looked up in the correct namespace.
     */

    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);







|


|





|














|







9015
9016
9017
9018
9019
9020
9021
9022
9023
9024
9025
9026
9027
9028
9029
9030
9031
9032
9033
9034
9035
9036
9037
9038
9039
9040
9041
9042
9043
9044
9045
9046
9047
9048
9049
9050
9051
9052
9053
    corPtr->running.framePtr = iPtr->rootFramePtr;
    corPtr->running.varFramePtr = iPtr->rootFramePtr;
    corPtr->running.cmdFramePtr = NULL;
    corPtr->running.lineLABCPtr = corPtr->lineLABCPtr;
    corPtr->stackLevel = NULL;
    corPtr->auxNumLevels = 0;
    iPtr->numLevels--;

    /*
     * Create the coro's execEnv, switch to it to push the exit and coro
     * command callbacks, then switch back.
     */

    corPtr->eePtr = TclCreateExecEnv(interp, CORO_STACK_INITIAL_SIZE);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    corPtr->eePtr->corPtr = corPtr;

    SAVE_CONTEXT(corPtr->caller);
    corPtr->callerEEPtr = iPtr->execEnvPtr;
    RESTORE_CONTEXT(corPtr->running);
    iPtr->execEnvPtr = corPtr->eePtr;

    TclNRAddCallback(interp, NRCoroutineExitCallback, corPtr,
	    NULL, NULL, NULL);

    iPtr->lookupNsPtr = lookupNsPtr;
    Tcl_NREvalObj(interp, Tcl_NewListObj(objc-2, objv+2), 0);

    SAVE_CONTEXT(corPtr->running);
    RESTORE_CONTEXT(corPtr->caller);
    iPtr->execEnvPtr = corPtr->callerEEPtr;

    /*
     * Now just resume the coroutine. Take care to insure that the command is
     * looked up in the correct namespace.
     */

    TclNRAddCallback(interp, NRCoroutineActivateCallback, corPtr,
            NULL, NULL, NULL);

Changes to generic/tclBinary.c.

301
302
303
304
305
306
307
308
309
310

311
312



313
314
315
316
317
318
319
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    Tcl_InvalidateStringRep(objPtr);

    length = (length < 0) ? 0 : length;
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));
    memset(byteArrayPtr, 0, BYTEARRAY_SIZE(length));
    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;

    if (bytes && length) {
	memcpy(byteArrayPtr->bytes, bytes, (size_t) length);



    }

    objPtr->typePtr = &tclByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}

/*







<


>
|
|
>
>
>







301
302
303
304
305
306
307

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
	Tcl_Panic("%s called with shared object", "Tcl_SetByteArrayObj");
    }
    TclFreeIntRep(objPtr);
    Tcl_InvalidateStringRep(objPtr);

    length = (length < 0) ? 0 : length;
    byteArrayPtr = ckalloc(BYTEARRAY_SIZE(length));

    byteArrayPtr->used = length;
    byteArrayPtr->allocated = length;
    if (length) {
	if (bytes) {
	    memcpy(byteArrayPtr->bytes, bytes, (size_t) length);
	} else {
	    memset(byteArrayPtr->bytes, 0, (size_t) length);
	}
    }

    objPtr->typePtr = &tclByteArrayType;
    SET_BYTEARRAY(objPtr, byteArrayPtr);
}

/*

Changes to generic/tclCmdAH.c.

1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
	 * For Windows, there are no user ids associated with a file, so we
	 * always return 1.
	 *
	 * TODO: use GetSecurityInfo to get the real owner of the file and
	 * test for equivalence to the current user.
	 */

#ifdef __WIN32__
	value = 1;
#else
	value = (geteuid() == buf.st_uid);
#endif
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;







|







1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
	 * For Windows, there are no user ids associated with a file, so we
	 * always return 1.
	 *
	 * TODO: use GetSecurityInfo to get the real owner of the file and
	 * test for equivalence to the current user.
	 */

#if defined(__WIN32__) || defined(__CYGWIN__)
	value = 1;
#else
	value = (geteuid() == buf.st_uid);
#endif
    }
    Tcl_SetObjResult(interp, Tcl_NewBooleanObj(value));
    return TCL_OK;

Changes to generic/tclCmdMZ.c.

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
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"digit",	"double",	"false",
	"graph",	"integer",	"list",		"lower",
	"print",	"punct",	"space",	"true",
	"upper",	"wideinteger",	"wordchar",	"xdigit",
	NULL
    };
    enum isClasses {
	STR_IS_ALNUM, STR_IS_ALPHA,	STR_IS_ASCII,  STR_IS_CONTROL,
	STR_IS_BOOL,  STR_IS_DIGIT,	STR_IS_DOUBLE, STR_IS_FALSE,
	STR_IS_GRAPH, STR_IS_INT,	STR_IS_LIST,   STR_IS_LOWER,

	STR_IS_PRINT, STR_IS_PUNCT, STR_IS_SPACE,  STR_IS_TRUE,
	STR_IS_UPPER, STR_IS_WIDE,	STR_IS_WORD,   STR_IS_XDIGIT
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptions {
	OPT_STRICT, OPT_FAILIDX
    };







|
|
|
|
|


|
|
|
>
|
|







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
    int (*chcomp)(int) = NULL;	/* The UniChar comparison function. */
    int i, failat = 0, result = 1, strict = 0, index, length1, length2;
    Tcl_Obj *objPtr, *failVarObj = NULL;
    Tcl_WideInt w;

    static const char *const isClasses[] = {
	"alnum",	"alpha",	"ascii",	"control",
	"boolean",	"digit",	"double",	"entier",
	"false",	"graph",	"integer",	"list",
	"lower",	"print",	"punct",	"space",
	"true",		"upper",	"wideinteger",	"wordchar",
	"xdigit",	NULL
    };
    enum isClasses {
	STR_IS_ALNUM,	STR_IS_ALPHA,	STR_IS_ASCII,	STR_IS_CONTROL,
	STR_IS_BOOL,	STR_IS_DIGIT,	STR_IS_DOUBLE,	STR_IS_ENTIER,
	STR_IS_FALSE,	STR_IS_GRAPH,	STR_IS_INT,	STR_IS_LIST,
	STR_IS_LOWER,	STR_IS_PRINT,	STR_IS_PUNCT,	STR_IS_SPACE,
	STR_IS_TRUE,	STR_IS_UPPER,	STR_IS_WIDE,	STR_IS_WORD,
	STR_IS_XDIGIT
    };
    static const char *const isOptions[] = {
	"-strict", "-failindex", NULL
    };
    enum isOptions {
	OPT_STRICT, OPT_FAILIDX
    };
1571
1572
1573
1574
1575
1576
1577













































1578
1579
1580
1581
1582
1583
1584
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}
	goto failedIntParse;













































    case STR_IS_WIDE:
	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);







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







1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
	chcomp = Tcl_UniCharIsGraph;
	break;
    case STR_IS_INT:
	if (TCL_OK == TclGetIntFromObj(NULL, objPtr, &i)) {
	    break;
	}
	goto failedIntParse;
    case STR_IS_ENTIER:
	if ((objPtr->typePtr == &tclIntType) ||
#ifndef NO_WIDE_TYPE
		(objPtr->typePtr == &tclWideIntType) ||
#endif
		(objPtr->typePtr == &tclBignumType)) {
	    break;
	}
	string1 = TclGetStringFromObj(objPtr, &length1);
	if (length1 == 0) {
	    if (strict) {
		result = 0;
	    }
	    goto str_is_done;
	}
	end = string1 + length1;
	if (TclParseNumber(NULL, objPtr, NULL, NULL, -1,
		(const char **) &stop, TCL_PARSE_INTEGER_ONLY) == TCL_OK) {
	    if (stop == end) {
		/*
		 * Entire string parses as an integer.
		 */

		break;
	    } else {
		/*
		 * Some prefix parsed as an integer, but not the whole string,
		 * so return failure index as the point where parsing stopped.
		 * Clear out the internal rep, since keeping it would leave
		 * *objPtr in an inconsistent state.
		 */

		result = 0;
		failat = stop - string1;
		TclFreeIntRep(objPtr);
	    }
	} else {
	    /*
	     * No prefix is a valid integer. Fail at beginning.
	     */

	    result = 0;
	    failat = 0;
	}
	break;
    case STR_IS_WIDE:
	if (TCL_OK == Tcl_GetWideIntFromObj(NULL, objPtr, &w)) {
	    break;
	}

    failedIntParse:
	string1 = TclGetStringFromObj(objPtr, &length1);

Changes to generic/tclCompCmds.c.

902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    SetLineInformation(4);
    CompileBody(envPtr, bodyTokenPtr, interp);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */








|







902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
    loopRange = DeclareExceptionRange(envPtr, LOOP_EXCEPTION_RANGE);
    ExceptionRangeStarts(envPtr, loopRange);

    /*
     * Compile the loop body itself. It should be stack-neutral.
     */

    SetLineInformation(3);
    CompileBody(envPtr, bodyTokenPtr, interp);
    TclEmitOpcode(	INST_POP,				envPtr);

    /*
     * Both exception target ranges (error and loop) end here.
     */

1108
1109
1110
1111
1112
1113
1114

1115
1116
1117
1118
1119
1120
1121
    TclEmitInt4(	infoIndex,				envPtr);

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);

    ExceptionRangeStarts(envPtr, range);
    envPtr->currStackDepth++;

    CompileBody(envPtr, bodyTokenPtr, interp);
    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeEnds(envPtr, range);

    /*
     * Normal termination code: the stack has the key list below the result of
     * the body evaluation: swap them and finish the update code.







>







1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
    TclEmitInt4(	infoIndex,				envPtr);

    range = DeclareExceptionRange(envPtr, CATCH_EXCEPTION_RANGE);
    TclEmitInstInt4(	INST_BEGIN_CATCH4, range,		envPtr);

    ExceptionRangeStarts(envPtr, range);
    envPtr->currStackDepth++;
    SetLineInformation(parsePtr->numWords - 1);
    CompileBody(envPtr, bodyTokenPtr, interp);
    envPtr->currStackDepth = savedStackDepth;
    ExceptionRangeEnds(envPtr, range);

    /*
     * Normal termination code: the stack has the key list below the result of
     * the body evaluation: swap them and finish the update code.
3142
3143
3144
3145
3146
3147
3148










3149
3150
3151
3152
3153
3154
3155

3156
3157
3158
3159
3160
3161
3162
    idxTokenPtr = TokenAfter(valTokenPtr);
    if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	Tcl_Obj *tmpObj;
	int idx, result;

	tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
	result = TclGetIntFromObj(NULL, tmpObj, &idx);










	TclDecrRefCount(tmpObj);

	if (result == TCL_OK && idx >= 0) {
	    /*
	     * All checks have been completed, and we have exactly this
	     * construct:
	     *	 lindex <arbitraryValue> <posInt>

	     * This is best compiled as a push of the arbitrary value followed
	     * by an "immediate lindex" which is the most efficient variety.
	     */

	    CompileWord(envPtr, valTokenPtr, interp, 1);
	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	    return TCL_OK;







>
>
>
>
>
>
>
>
>
>


|

|
|

>







3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
    idxTokenPtr = TokenAfter(valTokenPtr);
    if (idxTokenPtr->type == TCL_TOKEN_SIMPLE_WORD) {
	Tcl_Obj *tmpObj;
	int idx, result;

	tmpObj = Tcl_NewStringObj(idxTokenPtr[1].start, idxTokenPtr[1].size);
	result = TclGetIntFromObj(NULL, tmpObj, &idx);
	if (result == TCL_OK) {
	    if (idx < 0) {
		result = TCL_ERROR;
	    }
	} else {
	    result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx);
	    if (result == TCL_OK && idx > -2) {
		result = TCL_ERROR;
	    }
	}
	TclDecrRefCount(tmpObj);

	if (result == TCL_OK) {
	    /*
	     * All checks have been completed, and we have exactly one of
	     * these constructs:
	     *	 lindex <arbitraryValue> <posInt>
	     *	 lindex <arbitraryValue> end-<posInt>
	     * This is best compiled as a push of the arbitrary value followed
	     * by an "immediate lindex" which is the most efficient variety.
	     */

	    CompileWord(envPtr, valTokenPtr, interp, 1);
	    TclEmitInstInt4(	INST_LIST_INDEX_IMM, idx,	envPtr);
	    return TCL_OK;
3289
3290
3291
3292
3293
3294
3295




























































































































































































































3296
3297
3298
3299
3300
3301
3302
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr, varTokenPtr, interp, 1);
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    return TCL_OK;
}





























































































































































































































/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --
 *
 *	Procedure called to compile the "lset" command.







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







3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
    }
    varTokenPtr = TokenAfter(parsePtr->tokenPtr);

    CompileWord(envPtr, varTokenPtr, interp, 1);
    TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLrangeCmd --
 *
 *	How to compile the "lrange" command. We only bother because we needed
 *	the opcode anyway for "lassign".
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLrangeCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *tmpObj;
    int idx1, idx2, result;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Parse the first index. Will only compile if it is constant and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing).
     */

    tokenPtr = TokenAfter(listTokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }
    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
    result = TclGetIntFromObj(NULL, tmpObj, &idx1);
    if (result == TCL_OK) {
	if (idx1 < 0) {
	    result = TCL_ERROR;
	}
    } else {
	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
	if (result == TCL_OK && idx1 > -2) {
	    result = TCL_ERROR;
	}
    }
    TclDecrRefCount(tmpObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Parse the second index. Will only compile if it is constant and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing).
     */

    tokenPtr = TokenAfter(tokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }
    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
    result = TclGetIntFromObj(NULL, tmpObj, &idx2);
    if (result == TCL_OK) {
	if (idx2 < 0) {
	    result = TCL_ERROR;
	}
    } else {
	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
	if (result == TCL_OK && idx2 > -2) {
	    result = TCL_ERROR;
	}
    }
    TclDecrRefCount(tmpObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
     * we've not proved that the 'list' argument is really a list. Not that it
     * is worth trying to do that given current knowledge.
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    TclEmitInstInt4(		INST_LIST_RANGE_IMM, idx1,	envPtr);
    TclEmitInt4(		idx2,				envPtr);
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLreplaceCmd --
 *
 *	How to compile the "lreplace" command. We only bother with the case
 *	where there are no elements to insert and where both the 'first' and
 *	'last' arguments are constant and one can be deterined to be at the
 *	end of the list. (This is the case that could also be written with
 *	"lrange".)
 *
 *----------------------------------------------------------------------
 */

int
TclCompileLreplaceCmd(
    Tcl_Interp *interp,		/* Tcl interpreter for context. */
    Tcl_Parse *parsePtr,	/* Points to a parse structure for the
				 * command. */
    Command *cmdPtr,		/* Points to defintion of command being
				 * compiled. */
    CompileEnv *envPtr)		/* Holds the resulting instructions. */
{
    Tcl_Token *tokenPtr, *listTokenPtr;
    DefineLineInformation;	/* TIP #280 */
    Tcl_Obj *tmpObj;
    int idx1, idx2, result, guaranteedDropAll = 0;

    if (parsePtr->numWords != 4) {
	return TCL_ERROR;
    }
    listTokenPtr = TokenAfter(parsePtr->tokenPtr);

    /*
     * Parse the first index. Will only compile if it is constant and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing).
     */

    tokenPtr = TokenAfter(listTokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }
    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
    result = TclGetIntFromObj(NULL, tmpObj, &idx1);
    if (result == TCL_OK) {
	if (idx1 < 0) {
	    result = TCL_ERROR;
	}
    } else {
	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx1);
	if (result == TCL_OK && idx1 > -2) {
	    result = TCL_ERROR;
	}
    }
    TclDecrRefCount(tmpObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Parse the second index. Will only compile if it is constant and not an
     * _integer_ less than zero (since we reserve negative indices here for
     * end-relative indexing).
     */

    tokenPtr = TokenAfter(tokenPtr);
    if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
	return TCL_ERROR;
    }
    tmpObj = Tcl_NewStringObj(tokenPtr[1].start, tokenPtr[1].size);
    result = TclGetIntFromObj(NULL, tmpObj, &idx2);
    if (result == TCL_OK) {
	if (idx2 < 0) {
	    result = TCL_ERROR;
	}
    } else {
	result = TclGetIntForIndexM(NULL, tmpObj, -2, &idx2);
	if (result == TCL_OK && idx2 > -2) {
	    result = TCL_ERROR;
	}
    }
    TclDecrRefCount(tmpObj);
    if (result != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Sanity check: can only issue when we're removing a range at one or
     * other end of the list. If we're at one end or the other, convert the
     * indices into the equivalent for an [lrange].
     */

    if (idx1 == 0) {
	if (idx2 == -2) {
	    guaranteedDropAll = 1;
	}
	idx1 = idx2 + 1;
	idx2 = -2;
    } else if (idx2 == -2) {
	idx2 = idx1 - 1;
	idx1 = 0;
    } else {
	return TCL_ERROR;
    }

    /*
     * Issue instructions. It's not safe to skip doing the LIST_RANGE, as
     * we've not proved that the 'list' argument is really a list. Not that it
     * is worth trying to do that given current knowledge.
     */

    CompileWord(envPtr, listTokenPtr, interp, 1);
    if (guaranteedDropAll) {
	TclEmitOpcode(		INST_LIST_LENGTH,		envPtr);
	TclEmitOpcode(		INST_POP,			envPtr);
	PushLiteral(envPtr, "", 0);
    } else {
	TclEmitInstInt4(	INST_LIST_RANGE_IMM, idx1,	envPtr);
	TclEmitInt4(		idx2,				envPtr);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * TclCompileLsetCmd --
 *
 *	Procedure called to compile the "lset" command.

Changes to generic/tclCompExpr.c.

432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
};

/*
 * A table mapping a byte value to the corresponding lexeme for use by
 * ParseLexeme().
 */

static unsigned char Lexeme[] = {
	INVALID		/* NUL */,	INVALID		/* SOH */,
	INVALID		/* STX */,	INVALID		/* ETX */,
	INVALID		/* EOT */,	INVALID		/* ENQ */,
	INVALID		/* ACK */,	INVALID		/* BEL */,
	INVALID		/* BS */,	INVALID		/* HT */,
	INVALID		/* LF */,	INVALID		/* VT */,
	INVALID		/* FF */,	INVALID		/* CR */,







|







432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
};

/*
 * A table mapping a byte value to the corresponding lexeme for use by
 * ParseLexeme().
 */

static const unsigned char Lexeme[] = {
	INVALID		/* NUL */,	INVALID		/* SOH */,
	INVALID		/* STX */,	INVALID		/* ETX */,
	INVALID		/* EOT */,	INVALID		/* ENQ */,
	INVALID		/* ACK */,	INVALID		/* BEL */,
	INVALID		/* BS */,	INVALID		/* HT */,
	INVALID		/* LF */,	INVALID		/* VT */,
	INVALID		/* FF */,	INVALID		/* CR */,

Changes to generic/tclCompile.c.

4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601

4602
4603
4604
4605
4606
4607
4608

void
RecordByteCodeStats(
    ByteCode *codePtr)		/* Points to ByteCode structure with info
				 * to add to accumulated statistics. */
{
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    register ByteCodeStats *statsPtr = &iPtr->stats;

    if (iPtr == NULL) {
	/* Avoid segfaulting in case we're called in a deleted interp */
	return;
    }


    statsPtr->numCompilations++;
    statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
    statsPtr->totalByteCodeBytes += (double) codePtr->structureSize;
    statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes;
    statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;








|





>







4589
4590
4591
4592
4593
4594
4595
4596
4597
4598
4599
4600
4601
4602
4603
4604
4605
4606
4607
4608
4609

void
RecordByteCodeStats(
    ByteCode *codePtr)		/* Points to ByteCode structure with info
				 * to add to accumulated statistics. */
{
    Interp *iPtr = (Interp *) *codePtr->interpHandle;
    register ByteCodeStats *statsPtr;

    if (iPtr == NULL) {
	/* Avoid segfaulting in case we're called in a deleted interp */
	return;
    }
    statsPtr = &(iPtr->stats);

    statsPtr->numCompilations++;
    statsPtr->totalSrcBytes += (double) codePtr->numSrcBytes;
    statsPtr->totalByteCodeBytes += (double) codePtr->structureSize;
    statsPtr->currentSrcBytes += (double) codePtr->numSrcBytes;
    statsPtr->currentByteCodeBytes += (double) codePtr->structureSize;

Changes to generic/tclDecls.h.

1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
EXTERN int		Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 627 */
EXTERN int		Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
				const char *const symv[], int flags,
				void *procPtrs, Tcl_LoadHandle *handlePtr);
/* 628 */
EXTERN void*		Tcl_FindSymbol(Tcl_Interp *interp,
				Tcl_LoadHandle handle, const char *symbol);
/* 629 */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);

typedef struct TclStubHooks {
    const struct TclPlatStubs *tclPlatStubs;







|







1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
EXTERN int		Tcl_NRSubstObj(Tcl_Interp *interp, Tcl_Obj *objPtr,
				int flags);
/* 627 */
EXTERN int		Tcl_LoadFile(Tcl_Interp *interp, Tcl_Obj *pathPtr,
				const char *const symv[], int flags,
				void *procPtrs, Tcl_LoadHandle *handlePtr);
/* 628 */
EXTERN void *		Tcl_FindSymbol(Tcl_Interp *interp,
				Tcl_LoadHandle handle, const char *symbol);
/* 629 */
EXTERN int		Tcl_FSUnloadFile(Tcl_Interp *interp,
				Tcl_LoadHandle handlePtr);

typedef struct TclStubHooks {
    const struct TclPlatStubs *tclPlatStubs;
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
    int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */
    void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */
    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void* (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclStubs *tclStubsPtr;







|







2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
    int (*tcl_ZlibStreamReset) (Tcl_ZlibStream zshandle); /* 621 */
    void (*tcl_SetStartupScript) (Tcl_Obj *path, const char *encoding); /* 622 */
    Tcl_Obj * (*tcl_GetStartupScript) (const char **encodingPtr); /* 623 */
    int (*tcl_CloseEx) (Tcl_Interp *interp, Tcl_Channel chan, int flags); /* 624 */
    int (*tcl_NRExprObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, Tcl_Obj *resultPtr); /* 625 */
    int (*tcl_NRSubstObj) (Tcl_Interp *interp, Tcl_Obj *objPtr, int flags); /* 626 */
    int (*tcl_LoadFile) (Tcl_Interp *interp, Tcl_Obj *pathPtr, const char *const symv[], int flags, void *procPtrs, Tcl_LoadHandle *handlePtr); /* 627 */
    void * (*tcl_FindSymbol) (Tcl_Interp *interp, Tcl_LoadHandle handle, const char *symbol); /* 628 */
    int (*tcl_FSUnloadFile) (Tcl_Interp *interp, Tcl_LoadHandle handlePtr); /* 629 */
} TclStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclStubs *tclStubsPtr;

Changes to generic/tclEncoding.c.

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
 *
 *------------------------------------------------------------------------
 */

int
Tcl_SetSystemEncoding(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
    const char *name)		/* The name of the desired encoding, or NULL
				 * to reset to default encoding. */
{
    Tcl_Encoding encoding;
    Encoding *encodingPtr;

    if (name == NULL) {
	Tcl_MutexLock(&encodingMutex);
	encoding = defaultEncoding;
	encodingPtr = (Encoding *) encoding;
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
    } else {
	encoding = Tcl_GetEncoding(interp, name);







|





|







975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
 *
 *------------------------------------------------------------------------
 */

int
Tcl_SetSystemEncoding(
    Tcl_Interp *interp,		/* Interp for error reporting, if not NULL. */
    const char *name)		/* The name of the desired encoding, or NULL/""
				 * to reset to default encoding. */
{
    Tcl_Encoding encoding;
    Encoding *encodingPtr;

    if (!name || !*name) {
	Tcl_MutexLock(&encodingMutex);
	encoding = defaultEncoding;
	encodingPtr = (Encoding *) encoding;
	encodingPtr->refCount++;
	Tcl_MutexUnlock(&encodingMutex);
    } else {
	encoding = Tcl_GetEncoding(interp, name);

Changes to generic/tclEnsemble.c.

1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * count both as inserted and removed arguments.
	 */

#if 0
	if (TclInitRewriteEnsemble(interp, 2 + ensemblePtr->numParameters, prefixObjc + ensemblePtr->numParameters, objv)) {
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL, NULL);
	}
#else
	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	    iPtr->ensembleRewrite.sourceObjs = objv;
	    iPtr->ensembleRewrite.numRemovedObjs =
		    2 + ensemblePtr->numParameters;
	    iPtr->ensembleRewrite.numInsertedObjs =
		    prefixObjc + ensemblePtr->numParameters;
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
		    NULL);
	} else {
	    register int ni = 2 + ensemblePtr->numParameters
		    - iPtr->ensembleRewrite.numInsertedObjs;
				/* Position in objv of new front of insertion
				 * relative to old one. */
	    if (ni > 0) {
		iPtr->ensembleRewrite.numRemovedObjs += ni;
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
	    } else {
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
	    }
	}
#endif

	/*
	 * Hand off to the target command.
	 */

	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
	return Tcl_NREvalObj(interp, copyPtr, TCL_EVAL_INVOKE);
    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered
     * for dealing with this situation. Will only call (at most) once for any







<
<
<
<
<




















<






|







1819
1820
1821
1822
1823
1824
1825





1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845

1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859

	/*
	 * Record what arguments the script sent in so that things like
	 * Tcl_WrongNumArgs can give the correct error message. Parameters
	 * count both as inserted and removed arguments.
	 */






	if (iPtr->ensembleRewrite.sourceObjs == NULL) {
	    iPtr->ensembleRewrite.sourceObjs = objv;
	    iPtr->ensembleRewrite.numRemovedObjs =
		    2 + ensemblePtr->numParameters;
	    iPtr->ensembleRewrite.numInsertedObjs =
		    prefixObjc + ensemblePtr->numParameters;
	    TclNRAddCallback(interp, TclClearRootEnsemble, NULL, NULL, NULL,
		    NULL);
	} else {
	    register int ni = 2 + ensemblePtr->numParameters
		    - iPtr->ensembleRewrite.numInsertedObjs;
				/* Position in objv of new front of insertion
				 * relative to old one. */
	    if (ni > 0) {
		iPtr->ensembleRewrite.numRemovedObjs += ni;
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-1;
	    } else {
		iPtr->ensembleRewrite.numInsertedObjs += prefixObjc-2;
	    }
	}


	/*
	 * Hand off to the target command.
	 */

	iPtr->evalFlags |= TCL_EVAL_REDIRECT;
	return TclNREvalObjEx(interp, copyPtr, TCL_EVAL_INVOKE, NULL,INT_MIN);
    }

  unknownOrAmbiguousSubcommand:
    /*
     * Have not been able to match the subcommand asked for with a real
     * subcommand that we export. See whether a handler has been registered
     * for dealing with this situation. Will only call (at most) once for any
2885
2886
2887
2888
2889
2890
2891
2892



2893
2894
2895
2896
2897
2898
2899
	return TCL_ERROR;
    }
    targetCmdObj = elems[0];

    Tcl_IncrRefCount(targetCmdObj);
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
    TclDecrRefCount(targetCmdObj);
    if (cmdPtr == NULL || cmdPtr->compileProc == NULL) {



	/*
	 * Maps to an undefined command or a command without a compiler.
	 * Cannot compile.
	 */

	return TCL_ERROR;
    }







|
>
>
>







2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
	return TCL_ERROR;
    }
    targetCmdObj = elems[0];

    Tcl_IncrRefCount(targetCmdObj);
    cmdPtr = (Command *) Tcl_GetCommandFromObj(interp, targetCmdObj);
    TclDecrRefCount(targetCmdObj);
    if (cmdPtr == NULL || cmdPtr->compileProc == NULL
	    || cmdPtr->nsPtr->flags & NS_SUPPRESS_COMPILATION
	    || cmdPtr->flags * CMD_HAS_EXEC_TRACES
	    || ((Interp *)interp)->flags & DONT_COMPILE_CMDS_INLINE) {
	/*
	 * Maps to an undefined command or a command without a compiler.
	 * Cannot compile.
	 */

	return TCL_ERROR;
    }

Changes to generic/tclEnv.c.

41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
static char *		EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void	TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void	TclUnsetEnv(const char *name);

#if defined(__CYGWIN__)
/* On Cygwin, the environment is imported from the Cygwin DLL. */
     DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);
     DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
#    define putenv TclCygwinPutenv
static void		TclCygwinPutenv(char *string);
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclSetupEnv --
 *







<
|
<
|
<







41
42
43
44
45
46
47

48

49

50
51
52
53
54
55
56
static char *		EnvTraceProc(ClientData clientData, Tcl_Interp *interp,
			    const char *name1, const char *name2, int flags);
static void		ReplaceString(const char *oldStr, char *newStr);
MODULE_SCOPE void	TclSetEnv(const char *name, const char *value);
MODULE_SCOPE void	TclUnsetEnv(const char *name);

#if defined(__CYGWIN__)

    static void TclCygwinPutenv(char *string);

#   define putenv TclCygwinPutenv

#endif

/*
 *----------------------------------------------------------------------
 *
 * TclSetupEnv --
 *
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
    if (strcmp(name, "PATH") != 0) {
	/*
	 * If this is Path, eliminate any PATH variable, to prevent any
	 * confusion.
	 */

	if (strcmp(name, "Path") == 0) {
#ifdef __WIN32__
	    SetEnvironmentVariableA("PATH", NULL);
#endif
	    unsetenv("PATH");
	}

#ifdef __WIN32__
	SetEnvironmentVariableA(name, value);
#endif
    } else {
	char *buf;

	/*
	 * Eliminate any Path variable, to prevent any confusion.
	 */

#ifdef __WIN32__
	SetEnvironmentVariableA("Path", NULL);
#endif
	unsetenv("Path");

	if (value == NULL) {
	    buf = NULL;
	} else {
	    int size;

	    size = cygwin_posix_to_win32_path_list_buf_size(value);
	    buf = alloca(size + 1);
	    cygwin_posix_to_win32_path_list(value, buf);
	}

#ifdef __WIN32__
	SetEnvironmentVariableA(name, buf);
#endif
    }
}
#endif /* __CYGWIN__ */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







<

<



<

<







<

<












<

<











747
748
749
750
751
752
753

754

755
756
757

758

759
760
761
762
763
764
765

766

767
768
769
770
771
772
773
774
775
776
777
778

779

780
781
782
783
784
785
786
787
788
789
790
    if (strcmp(name, "PATH") != 0) {
	/*
	 * If this is Path, eliminate any PATH variable, to prevent any
	 * confusion.
	 */

	if (strcmp(name, "Path") == 0) {

	    SetEnvironmentVariableA("PATH", NULL);

	    unsetenv("PATH");
	}


	SetEnvironmentVariableA(name, value);

    } else {
	char *buf;

	/*
	 * Eliminate any Path variable, to prevent any confusion.
	 */


	SetEnvironmentVariableA("Path", NULL);

	unsetenv("Path");

	if (value == NULL) {
	    buf = NULL;
	} else {
	    int size;

	    size = cygwin_posix_to_win32_path_list_buf_size(value);
	    buf = alloca(size + 1);
	    cygwin_posix_to_win32_path_list(value, buf);
	}


	SetEnvironmentVariableA(name, buf);

    }
}
#endif /* __CYGWIN__ */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclExecute.c.

4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317





















4318
4319
4320
4321
4322
4323
4324

	/*
	 * Check if we are referring to a valid, non-empty list range, and if
	 * so, build the list of elements in that range.
	 */

	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
	    if (fromIdx<0) {
		fromIdx = 0;
	    }
	    if (toIdx >= objc) {
		toIdx = objc-1;





















	    }
	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),







|




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







4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345

	/*
	 * Check if we are referring to a valid, non-empty list range, and if
	 * so, build the list of elements in that range.
	 */

	if (fromIdx<=toIdx && fromIdx<objc && toIdx>=0) {
	    if (fromIdx < 0) {
		fromIdx = 0;
	    }
	    if (toIdx >= objc) {
		toIdx = objc-1;
	    }
	    if (fromIdx == 0 && toIdx != objc-1 && !Tcl_IsShared(valuePtr)) {
		/*
		 * BEWARE! This is looking inside the implementation of the
		 * list type.
		 */

		List *listPtr = valuePtr->internalRep.twoPtrValue.ptr1;

		if (listPtr->refCount == 1) {
		    TRACE(("\"%.30s\" %d %d => ", O2S(valuePtr),
			    TclGetInt4AtPtr(pc+1), TclGetInt4AtPtr(pc+5)));
		    for (index=toIdx+1 ; index<objc-1 ; index++) {
			TclDecrRefCount(objv[index]);
		    }
		    listPtr->elemCount = toIdx+1;
		    listPtr->canonicalFlag = 1;
		    TclInvalidateStringRep(valuePtr);
		    TRACE_APPEND(("%.30s\n", O2S(valuePtr)));
		    NEXT_INST_F(9, 0, 0);
		}
	    }
	    objResultPtr = Tcl_NewListObj(toIdx-fromIdx+1, objv+fromIdx);
	} else {
	    TclNewObj(objResultPtr);
	}

	TRACE_WITH_OBJ(("\"%.30s\" %d %d => ", O2S(valuePtr),
5712
5713
5714
5715
5716
5717
5718
5719
5720
5721
5722
5723
5724
5725
5726
		Tcl_IncrRefCount(value2Ptr);
		if (Tcl_IsShared(valuePtr)) {
		    valuePtr = Tcl_DuplicateObj(valuePtr);
		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr);
		}
		result = TclIncrObj(interp, valuePtr, value2Ptr);
		if (result == TCL_OK) {
		    Tcl_InvalidateStringRep(dictPtr);
		}
		TclDecrRefCount(value2Ptr);
	    }
	    break;
	case INST_DICT_UNSET:
	    cleanup = opnd;
	    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,







|







5733
5734
5735
5736
5737
5738
5739
5740
5741
5742
5743
5744
5745
5746
5747
		Tcl_IncrRefCount(value2Ptr);
		if (Tcl_IsShared(valuePtr)) {
		    valuePtr = Tcl_DuplicateObj(valuePtr);
		    Tcl_DictObjPut(NULL, dictPtr, OBJ_AT_TOS, valuePtr);
		}
		result = TclIncrObj(interp, valuePtr, value2Ptr);
		if (result == TCL_OK) {
		    TclInvalidateStringRep(dictPtr);
		}
		TclDecrRefCount(value2Ptr);
	    }
	    break;
	case INST_DICT_UNSET:
	    cleanup = opnd;
	    result = Tcl_DictObjRemoveKeyList(interp, dictPtr, opnd,

Changes to generic/tclFCmd.c.

516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
	/*
	 * Prevent copying or renaming a file onto itself. On Windows since
	 * 8.5 we do get an inode number, however the unsigned short field is
	 * insufficient to accept the Win32 API file id so it is truncated to
	 * 16 bits and we get collisions. See bug #2015723.
	 */

#ifndef WIN32
	if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
	    if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
		    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
		result = TCL_OK;
		goto done;
	    }
	}







|







516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
	/*
	 * Prevent copying or renaming a file onto itself. On Windows since
	 * 8.5 we do get an inode number, however the unsigned short field is
	 * insufficient to accept the Win32 API file id so it is truncated to
	 * 16 bits and we get collisions. See bug #2015723.
	 */

#if !defined(WIN32) && !defined(__CYGWIN__)
	if ((sourceStatBuf.st_ino != 0) && (targetStatBuf.st_ino != 0)) {
	    if ((sourceStatBuf.st_ino == targetStatBuf.st_ino) &&
		    (sourceStatBuf.st_dev == targetStatBuf.st_dev)) {
		result = TCL_OK;
		goto done;
	    }
	}

Changes to generic/tclFileName.c.

2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
	    }
	} else if (strchr(separators, *pattern) == NULL) {
	    break;
	}
	count++;
    }

    /*
     * This block of code is not exercised by the Tcl test suite as of Tcl
     * 8.5a0. Simplifications to the calling paths suggest it may not be
     * necessary any more, since path separators are handled elsewhere. It is
     * left in place in case new bugs are reported.
     */

#if 0 /* PROBABLY_OBSOLETE */
    /*
     * Deal with path separators.
     */

    if (pathPtr == NULL) {
	/*
	 * Length used to be the length of the prefix, and lastChar the
	 * lastChar of the prefix. But, none of this is used any more.
	 */

	int length = 0;
	char lastChar = 0;

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    /*
	     * If this is a drive relative path, add the colon and the
	     * trailing slash if needed. Otherwise add the slash if this is
	     * the first absolute element, or a later relative element. Add an
	     * extra slash if this is a UNC path.
	     */

	    if (*name == ':') {
		Tcl_DStringAppend(&append, ":", 1);
		if (count > 1) {
		    Tcl_DStringAppend(&append, "/", 1);
		}
	    } else if ((*pattern != '\0') && (((length > 0)
		    && (strchr(separators, lastChar) == NULL))
		    || ((length == 0) && (count > 0)))) {
		Tcl_DStringAppend(&append, "/", 1);
		if ((length == 0) && (count > 1)) {
		    Tcl_DStringAppend(&append, "/", 1);
		}
	    }

	    break;
	case TCL_PLATFORM_UNIX:
	    /*
	     * Add a separator if this is the first absolute element, or a
	     * later relative element.
	     */

	    if ((*pattern != '\0') && (((length > 0)
		    && (strchr(separators, lastChar) == NULL))
		    || ((length == 0) && (count > 0)))) {
		Tcl_DStringAppend(&append, "/", 1);
	    }
	    break;
	}
    }
#endif /* PROBABLY_OBSOLETE */

    /*
     * Look for the first matching pair of braces or the first directory
     * separator that is not inside a pair of braces.
     */

    openBrace = closeBrace = NULL;
    quoted = 0;







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







2155
2156
2157
2158
2159
2160
2161





























































2162
2163
2164
2165
2166
2167
2168
	    }
	} else if (strchr(separators, *pattern) == NULL) {
	    break;
	}
	count++;
    }






























































    /*
     * Look for the first matching pair of braces or the first directory
     * separator that is not inside a pair of braces.
     */

    openBrace = closeBrace = NULL;
    quoted = 0;
2274
2275
2276
2277
2278
2279
2280
2281
2282

2283
2284
2285
2286
2287
2288
2289

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */

    if (openBrace != NULL) {
	char *element;

	Tcl_DString newName;

	Tcl_DStringInit(&newName);

	/*
	 * For each element within in the outermost pair of braces, append the
	 * element and the remainder to the fixed portion before the first
	 * brace and recursively call DoGlob.
	 */







<

>







2213
2214
2215
2216
2217
2218
2219

2220
2221
2222
2223
2224
2225
2226
2227
2228

    /*
     * Substitute the alternate patterns from the braces and recurse.
     */

    if (openBrace != NULL) {
	char *element;

	Tcl_DString newName;

	Tcl_DStringInit(&newName);

	/*
	 * For each element within in the outermost pair of braces, append the
	 * element and the remainder to the fixed portion before the first
	 * brace and recursively call DoGlob.
	 */
2324
2325
2326
2327
2328
2329
2330


2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
     * Alternatively, if there are no globbing characters then again there are
     * two cases. If we're at the end of the string, we just need to check for
     * the given path's existence and type. If we're not at the end of the
     * string, we recurse.
     */

    if (*p != '\0') {


	/*
	 * Note that we are modifying the string in place. This won't work if
	 * the string is a static.
	 */

	char savedChar = *p;
	*p = '\0';
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
	*p = savedChar;
    } else {
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
    }








>
>





<







2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276

2277
2278
2279
2280
2281
2282
2283
     * Alternatively, if there are no globbing characters then again there are
     * two cases. If we're at the end of the string, we just need to check for
     * the given path's existence and type. If we're not at the end of the
     * string, we recurse.
     */

    if (*p != '\0') {
	char savedChar = *p;

	/*
	 * Note that we are modifying the string in place. This won't work if
	 * the string is a static.
	 */


	*p = '\0';
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
	*p = savedChar;
    } else {
	firstSpecialChar = strpbrk(pattern, "*[]?\\");
    }

2394
2395
2396
2397
2398
2399
2400

2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420



2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477


2478
2479
2480
2481
2482
2483
2484
		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			int numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
	    }
	}
	TclDecrRefCount(subdirsPtr);
	return result;
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {



	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and
	 * pass it to Tcl_FSMatchInDirectory with an empty pattern to verify
	 * the existence of the file and check it is of the correct type (if a
	 * 'types' flag it given -- if no such flag was given, we could just
	 * use 'Tcl_FSLStat', but for simplicity we keep to a common
	 * approach).
	 */

	int length;
	Tcl_DString append;

	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if (((*name == '\\') && (name[1] == '/' ||
			name[1] == '\\')) || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }

#if defined(__CYGWIN__) && defined(__WIN32__)
	    {
		char winbuf[MAX_PATH+1];

		cygwin_conv_to_win32_path(Tcl_DStringValue(&append), winbuf);
		Tcl_DStringFree(&append);
		Tcl_DStringAppend(&append, winbuf, -1);
	    }
#endif /* __CYGWIN__ && __WIN32__ */
	    break;

	case TCL_PLATFORM_UNIX:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }
#if defined(__CYGWIN__) && !defined(__WIN32__)
	    DLLIMPORT extern int cygwin_conv_to_posix_path(const char *, char *);
	    {


		char winbuf[MAXPATHLEN+1];

		cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
		Tcl_DStringFree(&append);
		Tcl_DStringAppend(&append, winbuf, -1);
	    }
#endif /* __CYGWIN__ && __WIN32__ */







>




















>
>
>












<
<
<




















<
<
<
<
<
<
<
<
<











<

>
>







2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376



2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396









2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407

2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
		    Tcl_DecrRefCount(subdirv[i]);
		    subdirv[i] = copy;
		    Tcl_ListObjLength(NULL, matchesObj, &end);
		    while (repair < end) {
			const char *bytes;
			int numBytes;
			Tcl_Obj *fixme, *newObj;

			Tcl_ListObjIndex(NULL, matchesObj, repair, &fixme);
			bytes = Tcl_GetStringFromObj(fixme, &numBytes);
			newObj = Tcl_NewStringObj(bytes+2, numBytes-2);
			Tcl_ListObjReplace(NULL, matchesObj, repair, 1,
				1, &newObj);
			repair++;
		    }
		    repair = -1;
		}
	    }
	}
	TclDecrRefCount(subdirsPtr);
	return result;
    }

    /*
     * We reach here with no pattern char in current section
     */

    if (*p == '\0') {
	int length;
	Tcl_DString append;

	/*
	 * This is the code path reached by a command like 'glob foo'.
	 *
	 * There are no more wildcards in the pattern and no more unprocessed
	 * characters in the pattern, so now we can construct the path, and
	 * pass it to Tcl_FSMatchInDirectory with an empty pattern to verify
	 * the existence of the file and check it is of the correct type (if a
	 * 'types' flag it given -- if no such flag was given, we could just
	 * use 'Tcl_FSLStat', but for simplicity we keep to a common
	 * approach).
	 */




	Tcl_DStringInit(&append);
	Tcl_DStringAppend(&append, pattern, p-pattern);

	if (pathPtr != NULL) {
	    (void) Tcl_GetStringFromObj(pathPtr, &length);
	} else {
	    length = 0;
	}

	switch (tclPlatform) {
	case TCL_PLATFORM_WINDOWS:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if (((*name == '\\') && (name[1] == '/' ||
			name[1] == '\\')) || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }










	    break;

	case TCL_PLATFORM_UNIX:
	    if (length == 0 && (Tcl_DStringLength(&append) == 0)) {
		if ((*name == '\\' && name[1] == '/') || (*name == '/')) {
		    Tcl_DStringAppend(&append, "/", 1);
		} else {
		    Tcl_DStringAppend(&append, ".", 1);
		}
	    }
#if defined(__CYGWIN__) && !defined(__WIN32__)

	    {
		DLLIMPORT extern int cygwin_conv_to_posix_path(const char *,
			char *);
		char winbuf[MAXPATHLEN+1];

		cygwin_conv_to_posix_path(Tcl_DStringValue(&append), winbuf);
		Tcl_DStringFree(&append);
		Tcl_DStringAppend(&append, winbuf, -1);
	    }
#endif /* __CYGWIN__ && __WIN32__ */

Changes to generic/tclHash.c.

42
43
44
45
46
47
48
49


50
51
52
53
54
55
56
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Prototypes for the one word hash key methods.


 */

#if 0
static Tcl_HashEntry *	AllocOneWordEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);







|
>
>







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
 */

static Tcl_HashEntry *	AllocArrayEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static int		CompareArrayKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashArrayKey(Tcl_HashTable *tablePtr, void *keyPtr);

/*
 * Prototypes for the one word hash key methods. Not actually declared because
 * this is a critical path that is implemented in the core hash table access
 * function.
 */

#if 0
static Tcl_HashEntry *	AllocOneWordEntry(Tcl_HashTable *tablePtr,
			    void *keyPtr);
static int		CompareOneWordKeys(void *keyPtr, Tcl_HashEntry *hPtr);
static unsigned int	HashOneWordKey(Tcl_HashTable *tablePtr, void *keyPtr);

Changes to generic/tclIOSock.c.

83
84
85
86
87
88
89
90
91
92
93
94

95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
 *
 * Side effects:
 *	Sets SO_SNDBUF and SO_RCVBUF sizes.
 *
 *----------------------------------------------------------------------
 */

#ifdef _WIN32
#   define PTR2SOCK(a) (SOCKET)a
#else
#   define PTR2SOCK(a) PTR2INT(a)
#endif

int
TclSockMinimumBuffers(
    ClientData sock,			/* Socket file descriptor */
    int size)			/* Minimum buffer size */
{
    int current;
    socklen_t len;

    len = sizeof(int);
    getsockopt(PTR2SOCK(sock), SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
    if (current < size) {
	len = sizeof(int);
	setsockopt(PTR2SOCK(sock), SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
    }
    len = sizeof(int);
    getsockopt(PTR2SOCK(sock), SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
    if (current < size) {
	len = sizeof(int);
	setsockopt(PTR2SOCK(sock), SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *







|
|
<
<

>


|






|


|


|


|







83
84
85
86
87
88
89
90
91


92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
 *
 * Side effects:
 *	Sets SO_SNDBUF and SO_RCVBUF sizes.
 *
 *----------------------------------------------------------------------
 */

#ifndef _WIN32
#   define SOCKET size_t


#endif

int
TclSockMinimumBuffers(
    void *sock,			/* Socket file descriptor */
    int size)			/* Minimum buffer size */
{
    int current;
    socklen_t len;

    len = sizeof(int);
    getsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&current, &len);
    if (current < size) {
	len = sizeof(int);
	setsockopt((SOCKET)sock, SOL_SOCKET, SO_SNDBUF, (char *)&size, len);
    }
    len = sizeof(int);
    getsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&current, &len);
    if (current < size) {
	len = sizeof(int);
	setsockopt((SOCKET)sock, SOL_SOCKET, SO_RCVBUF, (char *)&size, len);
    }
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
174
175
176
177
178
179
180

181
182
183
184
185
186
187
188
189
190

191
192
193


194
195
196

197
198
199
200
201
202
203
            } else if (strcmp(family, "inet6") == 0) {
                hints.ai_family = AF_INET6;
            }
        }
    }

    hints.ai_socktype = SOCK_STREAM;

#if 0
    /*
     * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
     * have no networking besides the loopback interface and want to resolve
     * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of
     * using AI_ADDRCONFIG in situations where it works, is probably low,
     * we'll leave it out for now. After all, it is just an optimisation.
     */
#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
    /*

     * Missing on: OpenBSD, NetBSD.
     * Causes failure when used on AIX 5.1 and HP-UX
     */


    hints.ai_flags |= AI_ADDRCONFIG;
#endif
#endif

    if (willBind) {
	hints.ai_flags |= AI_PASSIVE;
    } 

    result = getaddrinfo(native, portstring, &hints, addrlist);

    if (host != NULL) {







>







<
<
<
>



>
>

|
|
>







173
174
175
176
177
178
179
180
181
182
183
184
185
186
187



188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
            } else if (strcmp(family, "inet6") == 0) {
                hints.ai_family = AF_INET6;
            }
        }
    }

    hints.ai_socktype = SOCK_STREAM;

#if 0
    /*
     * We found some problems when using AI_ADDRCONFIG, e.g. on systems that
     * have no networking besides the loopback interface and want to resolve
     * localhost. See bugs 3385024, 3382419, 3382431. As the advantage of
     * using AI_ADDRCONFIG in situations where it works, is probably low,
     * we'll leave it out for now. After all, it is just an optimisation.



     *
     * Missing on: OpenBSD, NetBSD.
     * Causes failure when used on AIX 5.1 and HP-UX
     */

#if defined(AI_ADDRCONFIG) && !defined(_AIX) && !defined(__hpux)
    hints.ai_flags |= AI_ADDRCONFIG;
#endif /* AI_ADDRCONFIG && !_AIX && !__hpux */
#endif /* 0 */

    if (willBind) {
	hints.ai_flags |= AI_PASSIVE;
    } 

    result = getaddrinfo(native, portstring, &hints, addrlist);

    if (host != NULL) {

Changes to generic/tclIOUtil.c.

14
15
16
17
18
19
20



21
22
23
24
25
26
27
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */




#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

/*







>
>
>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 * Copyright (c) 1994-1997 Sun Microsystems, Inc.
 * Copyright (c) 2001-2004 Vincent Darley.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#if defined(HAVE_SYS_STAT_H) && !defined _WIN32
#   include <sys/stat.h>
#endif
#include "tclInt.h"
#ifdef __WIN32__
#   include "tclWinInt.h"
#endif
#include "tclFileSystem.h"

/*
1722
1723
1724
1725
1726
1727
1728






1729














1730
1731
1732
1733
1734
1735
1736
	    Tcl_Close(interp,chan);
	    return result;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);






    if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {














	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }

    if (Tcl_Close(interp, chan) != TCL_OK) {







>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
	    Tcl_Close(interp,chan);
	    return result;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	goto end;
    }

    if (Tcl_Close(interp, chan) != TCL_OK) {
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
    string = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * TIP #280 Force the evaluator to open a frame for a sourced file.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = Tcl_EvalEx(interp, string, length, 0);

    /*
     * Now we have to be careful; the script may have changed the
     * iPtr->scriptFile value, so we must reset it without assuming it still
     * points to 'pathPtr'.
     */








|







1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
    string = Tcl_GetStringFromObj(objPtr, &length);

    /*
     * TIP #280 Force the evaluator to open a frame for a sourced file.
     */

    iPtr->evalFlags |= TCL_EVAL_FILE;
    result = TclEvalEx(interp, string, length, 0, 1, NULL, string);

    /*
     * Now we have to be careful; the script may have changed the
     * iPtr->scriptFile value, so we must reset it without assuming it still
     * points to 'pathPtr'.
     */

1791
1792
1793
1794
1795
1796
1797

1798
1799
1800
1801
1802
1803
1804
    const char *encodingName)	/* If non-NULL, then use this encoding for the
				 * file. NULL means use the system encoding. */
{
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile, *objPtr;
    Interp *iPtr;
    Tcl_Channel chan;


    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
	Tcl_SetErrno(errno);







>







1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
    const char *encodingName)	/* If non-NULL, then use this encoding for the
				 * file. NULL means use the system encoding. */
{
    Tcl_StatBuf statBuf;
    Tcl_Obj *oldScriptFile, *objPtr;
    Interp *iPtr;
    Tcl_Channel chan;
    const char *string;

    if (Tcl_FSGetNormalizedPath(interp, pathPtr) == NULL) {
	return TCL_ERROR;
    }

    if (Tcl_FSStat(pathPtr, &statBuf) == -1) {
	Tcl_SetErrno(errno);
1832
1833
1834
1835
1836
1837
1838






1839















1840
1841
1842
1843
1844
1845
1846
	    Tcl_Close(interp,chan);
	    return TCL_ERROR;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);






    if (Tcl_ReadChars(chan, objPtr, -1, 0) < 0) {















	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }








>
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
	    Tcl_Close(interp,chan);
	    return TCL_ERROR;
	}
    }

    objPtr = Tcl_NewObj();
    Tcl_IncrRefCount(objPtr);

    /*
     * Try to read first character of stream, so we can check for utf-8 BOM to
     * be handled especially.
     */

    if (Tcl_ReadChars(chan, objPtr, 1, 0) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }
    string = Tcl_GetString(objPtr);

    /*
     * If first character is not a BOM, append the remaining characters,
     * otherwise replace them. [Bug 3466099]
     */

    if (Tcl_ReadChars(chan, objPtr, -1,
	    memcmp(string, "\xef\xbb\xbf", 3)) < 0) {
	Tcl_Close(interp, chan);
	Tcl_AppendResult(interp, "couldn't read file \"",
		Tcl_GetString(pathPtr), "\": ", Tcl_PosixError(interp), NULL);
	Tcl_DecrRefCount(objPtr);
	return TCL_ERROR;
    }

Changes to generic/tclInt.decls.

14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclInt
scspec EXTERN

# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.

# Replaced by Tcl_FSAccess in 8.4:







<







14
15
16
17
18
19
20

21
22
23
24
25
26
27
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

library tcl

# Define the unsupported generic interfaces.

interface tclInt


# Declare each of the functions in the unsupported internal Tcl
# interface.  These interfaces are allowed to changed between versions.
# Use at your own risk.  Note that the position of functions should not
# be changed between versions to avoid gratuitous incompatibilities.

# Replaced by Tcl_FSAccess in 8.4:
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)
#  }
# Removed in 8.5
#declare 27 {
#    int TclGetDate(char *p, unsigned long now, long zone,
#	    unsigned long *timePtr)
#}
declare 28 {
    Tcl_Channel TclpGetDefaultStdChannel(int type)
}
# Removed in 8.4b2:
#declare 29 {
#    Tcl_Obj *TclGetElementOfIndexedArray(Tcl_Interp *interp,







|
|







122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
}
# Removed in 8.1:
#  declare 26 {
#      char *TclGetCwd(Tcl_Interp *interp)
#  }
# Removed in 8.5
#declare 27 {
#    int TclGetDate(char *p, Tcl_WideInt now, long zone,
#	    Tcl_WideInt *timePtr)
#}
declare 28 {
    Tcl_Channel TclpGetDefaultStdChannel(int type)
}
# Removed in 8.4b2:
#declare 29 {
#    Tcl_Obj *TclGetElementOfIndexedArray(Tcl_Interp *interp,
316
317
318
319
320
321
322

323
324
325

326
327
328
329
330
331
332
    unsigned long TclpGetSeconds(void)
}

# deprecated
declare 77 {
    void TclpGetTime(Tcl_Time *time)
}

declare 78 {
    int TclpGetTimeZone(unsigned long time)
}

# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,







>
|
|
<
>







315
316
317
318
319
320
321
322
323
324

325
326
327
328
329
330
331
332
    unsigned long TclpGetSeconds(void)
}

# deprecated
declare 77 {
    void TclpGetTime(Tcl_Time *time)
}
# Removed in 8.6:
#declare 78 {
#    int TclpGetTimeZone(unsigned long time)

#}
# Replaced by Tcl_FSListVolumes in 8.4:
#declare 79 {
#    int TclpListVolumes(Tcl_Interp *interp)
#}
# Replaced by Tcl_FSOpenFileChannel in 8.4:
#declare 80 {
#    Tcl_Channel TclpOpenFileChannel(Tcl_Interp *interp, char *fileName,
417
418
419
420
421
422
423



424
425
426
427
428
429
430
431
    void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
	    int *portPtr)
}
declare 104 {



    int TclSockMinimumBuffers(ClientData sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
#    int TclStat(const char *path, Tcl_StatBuf *buf)
#}
#declare 106 {
#    int TclStatDeleteProc(TclStatProc_ *proc)







>
>
>
|







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
    void TclSetupEnv(Tcl_Interp *interp)
}
declare 103 {
    int TclSockGetPort(Tcl_Interp *interp, const char *str, const char *proto,
	    int *portPtr)
}
declare 104 {
    int TclSockMinimumBuffersOld(int sock, int size)
}
declare 110 {
    int TclSockMinimumBuffers(void *sock, int size)
}
# Replaced by Tcl_FSStat in 8.4:
#declare 105 {
#    int TclStat(const char *path, Tcl_StatBuf *buf)
#}
#declare 106 {
#    int TclStatDeleteProc(TclStatProc_ *proc)
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
            int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 171 {
    int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
            int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 172 {
    int TclInThreadExit(void)
}

# added for 8.4.2







|




|







688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
#}
# variant of Tcl_UtfNCmp that takes n as bytes, not chars
declare 169 {
    int TclpUtfNcmp2(const char *s1, const char *s2, unsigned long n)
}
declare 170 {
    int TclCheckInterpTraces(Tcl_Interp *interp, const char *command,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 171 {
    int TclCheckExecutionTraces(Tcl_Interp *interp, const char *command,
	    int numChars, Command *cmdPtr, int result, int traceFlags,
	    int objc, Tcl_Obj *const objv[])
}
declare 172 {
    int TclInThreadExit(void)
}

# added for 8.4.2
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
#declare 178 {
#    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
#    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
#}

# REMOVED
# Allocate lists without copying arrays
# declare 180 {
#    Tcl_Obj *TclNewListObjDirect(int objc, Tcl_Obj **objv)
# }
#declare 181 {
#    Tcl_Obj *TclDbNewListObjDirect(int objc, Tcl_Obj **objv,
#	    const char *file, int line)
#}

# TclpGmtime and TclpLocaltime promoted to the interface from unix

declare 182 {
     struct tm *TclpLocaltime(const time_t *clock)
}
declare 183 {
     struct tm *TclpGmtime(const time_t *clock)
}







<
<
<
<
<
<
<
<
<
<
|







735
736
737
738
739
740
741










742
743
744
745
746
747
748
749
#declare 178 {
#    void Tcl_SetStartupScript(Tcl_Obj *pathPtr, const char *encodingName)
#}
#declare 179 {
#    Tcl_Obj *Tcl_GetStartupScript(const char **encodingNamePtr)
#}











# TclpGmtime and TclpLocaltime promoted to the generic interface from unix

declare 182 {
     struct tm *TclpLocaltime(const time_t *clock)
}
declare 183 {
     struct tm *TclpGmtime(const time_t *clock)
}
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
}

declare 249 {
    char* TclDoubleDigits(double dv, int ndigits, int flags,
			  int* decpt, int* signum, char** endPtr)
}

# TIP #285: Script cancellation support.
declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

interface tclIntPlat

################################
# Windows specific functions

declare 0 win {
    void TclWinConvertError(unsigned long errCode)
}
declare 1 win {
    void TclWinConvertWSAError(unsigned long errCode)
}
declare 2 win {
    struct servent *TclWinGetServByName(const char *nm,
	    const char *proto)
}
declare 3 win {
    int TclWinGetSockOpt(SOCKET s, int level, int optname,
	    char FAR *optval, int FAR *optlen)
}
declare 4 win {
    HINSTANCE TclWinGetTclInstance(void)
}
# Removed in 8.1:
#  declare 5 win {
#      HINSTANCE TclWinLoadLibrary(char *name)
#  }
declare 6 win {
    u_short TclWinNToHS(u_short ns)
}
declare 7 win {
    int TclWinSetSockOpt(SOCKET s, int level, int optname,
	    const char FAR *optval, int optlen)
}
declare 8 win {
    unsigned long TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
    int TclWinGetPlatformId(void)
}







|
|

<
















|


|







|













|







985
986
987
988
989
990
991
992
993
994

995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043

declare 248 {
    int TclCopyChannel(Tcl_Interp *interp, Tcl_Channel inChan,
	    Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr)
}

declare 249 {
    char *TclDoubleDigits(double dv, int ndigits, int flags,
			  int *decpt, int *signum, char **endPtr)
}

# TIP #285: Script cancellation support.
declare 250 {
    void TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags, int force)
}

##############################################################################

# Define the platform specific internal Tcl interface. These functions are
# only available on the designated platform.

interface tclIntPlat

################################
# Windows specific functions

declare 0 win {
    void TclWinConvertError(DWORD errCode)
}
declare 1 win {
    void TclWinConvertWSAError(DWORD errCode)
}
declare 2 win {
    struct servent *TclWinGetServByName(const char *nm,
	    const char *proto)
}
declare 3 win {
    int TclWinGetSockOpt(SOCKET s, int level, int optname,
	    char *optval, int *optlen)
}
declare 4 win {
    HINSTANCE TclWinGetTclInstance(void)
}
# Removed in 8.1:
#  declare 5 win {
#      HINSTANCE TclWinLoadLibrary(char *name)
#  }
declare 6 win {
    u_short TclWinNToHS(u_short ns)
}
declare 7 win {
    int TclWinSetSockOpt(SOCKET s, int level, int optname,
	    const char *optval, int optlen)
}
declare 8 win {
    unsigned long TclpGetPid(Tcl_Pid pid)
}
declare 9 win {
    int TclWinGetPlatformId(void)
}
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102

1103
1104
1105

1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(void *hProcess, unsigned long id)
}

# removed permanently for 8.4
#declare 21 win {
#    void TclpAsyncMark(Tcl_AsyncHandler async)
#}

# Added in 8.1:
declare 22 win {
    TclFile TclpCreateTempFile(const char *contents)
}

declare 23 win {
    char *TclpGetTZName(int isdst)
}

declare 24 win {
    char *TclWinNoBackslash(char *path)
}
# replaced by TclGetPlatform
#declare 25 win {
#    TclPlatformType *TclWinGetPlatform(void)
#}
declare 26 win {
    void TclWinSetInterfaces(int wide)
}








|











>
|
|
<
>



|







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
1103
1104
1105
1106
1107
1108
1109
declare 18 win {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)
}
declare 19 win {
    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 20 win {
    void TclWinAddProcess(HANDLE hProcess, DWORD id)
}

# removed permanently for 8.4
#declare 21 win {
#    void TclpAsyncMark(Tcl_AsyncHandler async)
#}

# Added in 8.1:
declare 22 win {
    TclFile TclpCreateTempFile(const char *contents)
}
# Removed in 8.6:
#declare 23 win {
#    char *TclpGetTZName(int isdst)

#}
declare 24 win {
    char *TclWinNoBackslash(char *path)
}
# replaced by generic TclGetPlatform
#declare 25 win {
#    TclPlatformType *TclWinGetPlatform(void)
#}
declare 26 win {
    void TclWinSetInterfaces(int wide)
}

1130
1131
1132
1133
1134
1135
1136

1137
1138
1139

1140
1141
1142
1143
1144
1145
1146
1147
1148
1149

1150
1151
1152
1153
1154
1155
1156
1157
1158


1159
1160

1161

1162

1163
1164
1165
1166
1167
1168
1169
1170

1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181

1182
1183
1184

1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201

1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213

1214
1215
1216
1217
1218

1219
1220
1221



























1222
1223
1224
1225
1226
}

################################
# Unix specific functions

# Pipe channel functions


declare 0 unix {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}

declare 1 unix {
    int TclpCloseFile(TclFile file)
}
declare 2 unix {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 unix {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}

declare 4 unix {
    int TclpCreateProcess(Tcl_Interp *interp, int argc, const char **argv,
	    TclFile inputFile, TclFile outputFile, TclFile errorFile,
	    Tcl_Pid *pidPtr)
}
# Signature changed in 8.1:
#  declare 5 unix {
#      TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
#  }


declare 6 unix {
    TclFile TclpMakeFile(Tcl_Channel channel, int direction)

}

declare 7 unix {

    TclFile TclpOpenFile(const char *fname, int mode)
}
declare 8 unix {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}

# Added in 8.1:


declare 9 unix {
    TclFile TclpCreateTempFile(const char *contents)
}

# Added in 8.4:

declare 10 unix {
    Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# Stubs

declare 11 unix {
    struct tm *TclpLocaltime_unix(const time_t *clock)
}

declare 12 unix {
    struct tm *TclpGmtime_unix(const time_t *clock)
}
declare 13 unix {
    char *TclpInetNtoa(struct in_addr addr)
}

# Added in 8.5:

declare 14 unix {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}

################################
# Mac OS X specific functions


declare 15 macosx {
    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
}
declare 16 macosx {
    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
}
declare 17 macosx {
    int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr)
}

declare 18 macosx {
    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
	    const char *fileName, Tcl_StatBuf *statBufPtr,
	    Tcl_GlobTypeData *types)
}

declare 19 macosx {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}





























# Local Variables:
# mode: tcl
# End:







>

|

>

|








>

<
<
|





>
>

<
>

>

>
|







>

|








|
>



>

















>
|











>
|




>
|


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





1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146


1147
1148
1149
1150
1151
1152
1153
1154
1155

1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
}

################################
# Unix specific functions

# Pipe channel functions

# On non-cygwin, this is actually a reference to TclGetAndDetachPids
declare 0 unix {
    void TclWinConvertError(unsigned int errCode)
}
# On non-cygwin, this is actually a reference to TclpCloseFile
declare 1 unix {
    void TclWinConvertWSAError(unsigned int errCode)
}
declare 2 unix {
    Tcl_Channel TclpCreateCommandChannel(TclFile readFile,
	    TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr)
}
declare 3 unix {
    int TclpCreatePipe(TclFile *readPipe, TclFile *writePipe)
}
# On non-cygwin, this is actually a reference to TclpCreateProcess
declare 4 unix {


    void *TclWinGetTclInstance(void)
}
# Signature changed in 8.1:
#  declare 5 unix {
#      TclFile TclpCreateTempFile(char *contents, Tcl_DString *namePtr)
#  }

# On non-cygwin, this is actually a reference to TclpMakeFile
declare 6 unix {

    unsigned short TclWinNToHS(unsigned short ns)
}
# On non-cygwin, this is actually a reference to TclpOpenFile
declare 7 unix {
    int TclWinSetSockOpt(void *s, int level, int optname,
	    const char *optval, int optlen)
}
declare 8 unix {
    int TclUnixWaitForFile(int fd, int mask, int timeout)
}

# Added in 8.1:

# On non-cygwin, this is actually a reference to TclpCreateTempFile
declare 9 unix {
    int TclWinGetPlatformId(void)
}

# Added in 8.4:

declare 10 unix {
    Tcl_DirEntry *TclpReaddir(DIR *dir)
}
# Slots 11 and 12 are forwarders for functions that were promoted to
# generic Stubs
# On cygwin, this is actually a reference to TclGetAndDetachPids
declare 11 unix {
    struct tm *TclpLocaltime_unix(const time_t *clock)
}
# On cygwin, this is actually a reference to TclpCloseFile
declare 12 unix {
    struct tm *TclpGmtime_unix(const time_t *clock)
}
declare 13 unix {
    char *TclpInetNtoa(struct in_addr addr)
}

# Added in 8.5:

declare 14 unix {
    int TclUnixCopyFile(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr, int dontCopyAtts)
}

################################
# Mac OS X specific functions

#On cygwin, TclpCreateProcess is here
declare 15 {unix macosx} {
    int TclMacOSXGetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr)
}
declare 16 macosx {
    int TclMacOSXSetFileAttribute(Tcl_Interp *interp, int objIndex,
	    Tcl_Obj *fileName, Tcl_Obj *attributePtr)
}
declare 17 macosx {
    int TclMacOSXCopyFileAttributes(const char *src, const char *dst,
	    const Tcl_StatBuf *statBufPtr)
}
#On cygwin, TclpMakeFile is here
declare 18 {unix macosx} {
    int TclMacOSXMatchType(Tcl_Interp *interp, const char *pathName,
	    const char *fileName, Tcl_StatBuf *statBufPtr,
	    Tcl_GlobTypeData *types)
}
#On cygwin, TclpOpenFile is here
declare 19 {unix macosx} {
    void TclMacOSXNotifierAddRunLoopMode(const void *runLoopMode)
}
declare 20 unix {
    void TclWinAddProcess(void *hProcess, unsigned int id)
}
declare 22 unix {
    TclFile TclpCreateTempFile(const char *contents)
}
declare 24 unix {
    char *TclWinNoBackslash(char *path)
}
declare 26 unix {
    void TclWinSetInterfaces(int wide)
}
declare 27 unix {
    void TclWinFlushDirtyChannels(void)
}
declare 28 unix {
    void TclWinResetInterfaces(void)
}
declare 29 unix {
    int TclWinCPUID(unsigned int index, unsigned int *regs)
}
declare 30 unix {
    void TclGetAndDetachPids(Tcl_Interp *interp, Tcl_Channel chan)
}
declare 31 unix {
    int TclpCloseFile(TclFile file)
}


# Local Variables:
# mode: tcl
# End:

Changes to generic/tclInt.h.

3542
3543
3544
3545
3546
3547
3548






3549
3550
3551
3552
3553
3554
3555
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileListCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLlengthCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,






			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLsetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNamespaceUpvarCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);







>
>
>
>
>
>







3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileListCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLlengthCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLrangeCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLreplaceCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileLsetCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);
MODULE_SCOPE int	TclCompileNamespaceUpvarCmd(Tcl_Interp *interp,
			    Tcl_Parse *parsePtr, Command *cmdPtr,
			    struct CompileEnv *envPtr);

Changes to generic/tclIntDecls.h.

210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
EXTERN void		TclpFree(char *ptr);
/* 75 */
EXTERN unsigned long	TclpGetClicks(void);
/* 76 */
EXTERN unsigned long	TclpGetSeconds(void);
/* 77 */
EXTERN void		TclpGetTime(Tcl_Time *time);
/* 78 */
EXTERN int		TclpGetTimeZone(unsigned long time);
/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */







|
<







210
211
212
213
214
215
216
217

218
219
220
221
222
223
224
EXTERN void		TclpFree(char *ptr);
/* 75 */
EXTERN unsigned long	TclpGetClicks(void);
/* 76 */
EXTERN unsigned long	TclpGetSeconds(void);
/* 77 */
EXTERN void		TclpGetTime(Tcl_Time *time);
/* Slot 78 is reserved */

/* Slot 79 is reserved */
/* Slot 80 is reserved */
/* 81 */
EXTERN char *		TclpRealloc(char *ptr, unsigned int size);
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274

275
276
277
278
279
280
281
EXTERN CONST86 char *	TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* 104 */
EXTERN int		TclSockMinimumBuffers(ClientData sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
/* 108 */
EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
/* Slot 110 is reserved */

/* 111 */
EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
				const char *name,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */







|







|
>







258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
EXTERN CONST86 char *	TclSetPreInitScript(const char *string);
/* 102 */
EXTERN void		TclSetupEnv(Tcl_Interp *interp);
/* 103 */
EXTERN int		TclSockGetPort(Tcl_Interp *interp, const char *str,
				const char *proto, int *portPtr);
/* 104 */
EXTERN int		TclSockMinimumBuffersOld(int sock, int size);
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
/* 108 */
EXTERN void		TclTeardownNamespace(Namespace *nsPtr);
/* 109 */
EXTERN int		TclUpdateReturnInfo(Interp *iPtr);
/* 110 */
EXTERN int		TclSockMinimumBuffers(void *sock, int size);
/* 111 */
EXTERN void		Tcl_AddInterpResolvers(Tcl_Interp *interp,
				const char *name,
				Tcl_ResolveCmdProc *cmdProc,
				Tcl_ResolveVarProc *varProc,
				Tcl_ResolveCompiledVarProc *compiledVarProc);
/* 112 */
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
EXTERN int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
EXTERN char*		TclDoubleDigits(double dv, int ndigits, int flags,
				int*decpt, int*signum, char**endPtr);
/* 250 */
EXTERN void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);

typedef struct TclIntStubs {
    int magic;
    const struct TclIntStubHooks *hooks;







|
|







592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
EXTERN void		TclResetRewriteEnsemble(Tcl_Interp *interp,
				int isRootEnsemble);
/* 248 */
EXTERN int		TclCopyChannel(Tcl_Interp *interp,
				Tcl_Channel inChan, Tcl_Channel outChan,
				Tcl_WideInt toRead, Tcl_Obj *cmdPtr);
/* 249 */
EXTERN char *		TclDoubleDigits(double dv, int ndigits, int flags,
				int *decpt, int *signum, char **endPtr);
/* 250 */
EXTERN void		TclSetSlaveCancelFlags(Tcl_Interp *interp, int flags,
				int force);

typedef struct TclIntStubs {
    int magic;
    const struct TclIntStubHooks *hooks;
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (char *ptr); /* 74 */
    unsigned long (*tclpGetClicks) (void); /* 75 */
    unsigned long (*tclpGetSeconds) (void); /* 76 */
    void (*tclpGetTime) (Tcl_Time *time); /* 77 */
    int (*tclpGetTimeZone) (unsigned long time); /* 78 */
    void (*reserved79)(void);
    void (*reserved80)(void);
    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);







|







680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
    void (*reserved71)(void);
    void (*reserved72)(void);
    void (*reserved73)(void);
    void (*tclpFree) (char *ptr); /* 74 */
    unsigned long (*tclpGetClicks) (void); /* 75 */
    unsigned long (*tclpGetSeconds) (void); /* 76 */
    void (*tclpGetTime) (Tcl_Time *time); /* 77 */
    void (*reserved78)(void);
    void (*reserved79)(void);
    void (*reserved80)(void);
    char * (*tclpRealloc) (char *ptr, unsigned int size); /* 81 */
    void (*reserved82)(void);
    void (*reserved83)(void);
    void (*reserved84)(void);
    void (*reserved85)(void);
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);
    CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
    int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
    int (*tclSockMinimumBuffers) (ClientData sock, int size); /* 104 */
    void (*reserved105)(void);
    void (*reserved106)(void);
    void (*reserved107)(void);
    void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
    int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
    void (*reserved110)(void);
    void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */







|





|







706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
    void (*tclResetShadowedCmdRefs) (Tcl_Interp *interp, Command *newCmdPtr); /* 97 */
    int (*tclServiceIdle) (void); /* 98 */
    void (*reserved99)(void);
    void (*reserved100)(void);
    CONST86 char * (*tclSetPreInitScript) (const char *string); /* 101 */
    void (*tclSetupEnv) (Tcl_Interp *interp); /* 102 */
    int (*tclSockGetPort) (Tcl_Interp *interp, const char *str, const char *proto, int *portPtr); /* 103 */
    int (*tclSockMinimumBuffersOld) (int sock, int size); /* 104 */
    void (*reserved105)(void);
    void (*reserved106)(void);
    void (*reserved107)(void);
    void (*tclTeardownNamespace) (Namespace *nsPtr); /* 108 */
    int (*tclUpdateReturnInfo) (Interp *iPtr); /* 109 */
    int (*tclSockMinimumBuffers) (void *sock, int size); /* 110 */
    void (*tcl_AddInterpResolvers) (Tcl_Interp *interp, const char *name, Tcl_ResolveCmdProc *cmdProc, Tcl_ResolveVarProc *varProc, Tcl_ResolveCompiledVarProc *compiledVarProc); /* 111 */
    int (*tcl_AppendExportList) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, Tcl_Obj *objPtr); /* 112 */
    Tcl_Namespace * (*tcl_CreateNamespace) (Tcl_Interp *interp, const char *name, ClientData clientData, Tcl_NamespaceDeleteProc *deleteProc); /* 113 */
    void (*tcl_DeleteNamespace) (Tcl_Namespace *nsPtr); /* 114 */
    int (*tcl_Export) (Tcl_Interp *interp, Tcl_Namespace *nsPtr, const char *pattern, int resetListFirst); /* 115 */
    Tcl_Command (*tcl_FindCommand) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 116 */
    Tcl_Namespace * (*tcl_FindNamespace) (Tcl_Interp *interp, const char *name, Tcl_Namespace *contextNsPtr, int flags); /* 117 */
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char* (*tclDoubleDigits) (double dv, int ndigits, int flags, int*decpt, int*signum, char**endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
} TclIntStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclIntStubs *tclIntStubsPtr;







|







851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
    int (*tclNREvalObjv) (Tcl_Interp *interp, int objc, Tcl_Obj *const objv[], int flags, Command *cmdPtr); /* 242 */
    void (*tclDbDumpActiveObjects) (FILE *outFile); /* 243 */
    Tcl_HashTable * (*tclGetNamespaceChildTable) (Tcl_Namespace *nsPtr); /* 244 */
    Tcl_HashTable * (*tclGetNamespaceCommandTable) (Tcl_Namespace *nsPtr); /* 245 */
    int (*tclInitRewriteEnsemble) (Tcl_Interp *interp, int numRemoved, int numInserted, Tcl_Obj *const *objv); /* 246 */
    void (*tclResetRewriteEnsemble) (Tcl_Interp *interp, int isRootEnsemble); /* 247 */
    int (*tclCopyChannel) (Tcl_Interp *interp, Tcl_Channel inChan, Tcl_Channel outChan, Tcl_WideInt toRead, Tcl_Obj *cmdPtr); /* 248 */
    char * (*tclDoubleDigits) (double dv, int ndigits, int flags, int *decpt, int *signum, char **endPtr); /* 249 */
    void (*tclSetSlaveCancelFlags) (Tcl_Interp *interp, int flags, int force); /* 250 */
} TclIntStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclIntStubs *tclIntStubsPtr;
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
	(tclIntStubsPtr->tclpFree) /* 74 */
#define TclpGetClicks \
	(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
	(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
	(tclIntStubsPtr->tclpGetTime) /* 77 */
#define TclpGetTimeZone \
	(tclIntStubsPtr->tclpGetTimeZone) /* 78 */
/* Slot 79 is reserved */
/* Slot 80 is reserved */
#define TclpRealloc \
	(tclIntStubsPtr->tclpRealloc) /* 81 */
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */







|
<







991
992
993
994
995
996
997
998

999
1000
1001
1002
1003
1004
1005
	(tclIntStubsPtr->tclpFree) /* 74 */
#define TclpGetClicks \
	(tclIntStubsPtr->tclpGetClicks) /* 75 */
#define TclpGetSeconds \
	(tclIntStubsPtr->tclpGetSeconds) /* 76 */
#define TclpGetTime \
	(tclIntStubsPtr->tclpGetTime) /* 77 */
/* Slot 78 is reserved */

/* Slot 79 is reserved */
/* Slot 80 is reserved */
#define TclpRealloc \
	(tclIntStubsPtr->tclpRealloc) /* 81 */
/* Slot 82 is reserved */
/* Slot 83 is reserved */
/* Slot 84 is reserved */
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045

1046
1047
1048
1049
1050
1051
1052
1053
/* Slot 100 is reserved */
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#define TclSetupEnv \
	(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
	(tclIntStubsPtr->tclSockGetPort) /* 103 */
#define TclSockMinimumBuffers \
	(tclIntStubsPtr->tclSockMinimumBuffers) /* 104 */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
#define TclTeardownNamespace \
	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#define TclUpdateReturnInfo \
	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */

/* Slot 110 is reserved */
#define Tcl_AddInterpResolvers \
	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define Tcl_AppendExportList \
	(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
#define Tcl_CreateNamespace \
	(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
#define Tcl_DeleteNamespace \







|
|







>
|







1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
/* Slot 100 is reserved */
#define TclSetPreInitScript \
	(tclIntStubsPtr->tclSetPreInitScript) /* 101 */
#define TclSetupEnv \
	(tclIntStubsPtr->tclSetupEnv) /* 102 */
#define TclSockGetPort \
	(tclIntStubsPtr->tclSockGetPort) /* 103 */
#define TclSockMinimumBuffersOld \
	(tclIntStubsPtr->tclSockMinimumBuffersOld) /* 104 */
/* Slot 105 is reserved */
/* Slot 106 is reserved */
/* Slot 107 is reserved */
#define TclTeardownNamespace \
	(tclIntStubsPtr->tclTeardownNamespace) /* 108 */
#define TclUpdateReturnInfo \
	(tclIntStubsPtr->tclUpdateReturnInfo) /* 109 */
#define TclSockMinimumBuffers \
	(tclIntStubsPtr->tclSockMinimumBuffers) /* 110 */
#define Tcl_AddInterpResolvers \
	(tclIntStubsPtr->tcl_AddInterpResolvers) /* 111 */
#define Tcl_AppendExportList \
	(tclIntStubsPtr->tcl_AppendExportList) /* 112 */
#define Tcl_CreateNamespace \
	(tclIntStubsPtr->tcl_CreateNamespace) /* 113 */
#define Tcl_DeleteNamespace \

Changes to generic/tclIntPlatDecls.h.

20
21
22
23
24
25
26










27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59

60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76




































77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif











/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tclInt.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */

EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);




































#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
/* 0 */
EXTERN void		TclWinConvertError(unsigned long errCode);
/* 1 */
EXTERN void		TclWinConvertWSAError(unsigned long errCode);
/* 2 */
EXTERN struct servent *	 TclWinGetServByName(const char *nm,
				const char *proto);
/* 3 */
EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
				char FAR *optval, int FAR *optlen);
/* 4 */
EXTERN HINSTANCE	TclWinGetTclInstance(void);
/* Slot 5 is reserved */
/* 6 */
EXTERN u_short		TclWinNToHS(u_short ns);
/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char FAR *optval, int optlen);
/* 8 */
EXTERN unsigned long	TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* Slot 10 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,







>
>
>
>
>
>
>
>
>
>














|
<

|







|
<
<
<


|

>
|



|












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



|

|





|







|







20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51

52
53
54
55
56
57
58
59
60
61



62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
#   ifdef USE_TCL_STUBS
#      define TCL_STORAGE_CLASS
#   else
#      define TCL_STORAGE_CLASS DLLIMPORT
#   endif
#endif

#if !defined(__WIN32__) /* UNIX */
EXTERN int TclpCreateProcess(Tcl_Interp *interp,
	int argc, CONST char **argv, TclFile inputFile,
	TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr);
EXTERN TclFile TclpMakeFile(Tcl_Channel channel,
	int direction);
EXTERN TclFile TclpOpenFile(CONST char *fname,
	int mode);
#endif

/*
 * WARNING: This file is automatically generated by the tools/genStubs.tcl
 * script.  Any modifications to the function declarations below should be made
 * in the generic/tclInt.decls script.
 */

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN void		TclWinConvertError(unsigned int errCode);

/* 1 */
EXTERN void		TclWinConvertWSAError(unsigned int errCode);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);



/* Slot 5 is reserved */
/* 6 */
EXTERN unsigned short	TclWinNToHS(unsigned short ns);
/* 7 */
EXTERN int		TclWinSetSockOpt(void *s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
EXTERN char *		TclpInetNtoa(struct in_addr addr);
/* 14 */
EXTERN int		TclUnixCopyFile(const char *src, const char *dst,
				const Tcl_StatBuf *statBufPtr,
				int dontCopyAtts);
/* 15 */
EXTERN int		TclMacOSXGetFileAttribute(Tcl_Interp *interp,
				int objIndex, Tcl_Obj *fileName,
				Tcl_Obj **attributePtrPtr);
/* Slot 16 is reserved */
/* Slot 17 is reserved */
/* 18 */
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, unsigned int id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void		TclWinResetInterfaces(void);
/* 29 */
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 31 */
EXTERN int		TclpCloseFile(TclFile file);
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
/* 0 */
EXTERN void		TclWinConvertError(DWORD errCode);
/* 1 */
EXTERN void		TclWinConvertWSAError(DWORD errCode);
/* 2 */
EXTERN struct servent *	 TclWinGetServByName(const char *nm,
				const char *proto);
/* 3 */
EXTERN int		TclWinGetSockOpt(SOCKET s, int level, int optname,
				char *optval, int *optlen);
/* 4 */
EXTERN HINSTANCE	TclWinGetTclInstance(void);
/* Slot 5 is reserved */
/* 6 */
EXTERN u_short		TclWinNToHS(u_short ns);
/* 7 */
EXTERN int		TclWinSetSockOpt(SOCKET s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN unsigned long	TclpGetPid(Tcl_Pid pid);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* Slot 10 is reserved */
/* 11 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163

164
165
166
167
168
169
170
171
172
173
174
175
/* Slot 16 is reserved */
/* Slot 17 is reserved */
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, unsigned long id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 23 */
EXTERN char *		TclpGetTZName(int isdst);
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void		TclWinResetInterfaces(void);
/* 29 */
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 1 */
EXTERN int		TclpCloseFile(TclFile file);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN int		TclpCreateProcess(Tcl_Interp *interp, int argc,
				const char **argv, TclFile inputFile,
				TclFile outputFile, TclFile errorFile,
				Tcl_Pid *pidPtr);
/* Slot 5 is reserved */
/* 6 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 7 */

EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */







|



|
<














|
<

|







|
<
<
<


|

>
|



|







161
162
163
164
165
166
167
168
169
170
171
172

173
174
175
176
177
178
179
180
181
182
183
184
185
186
187

188
189
190
191
192
193
194
195
196
197



198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
/* Slot 16 is reserved */
/* Slot 17 is reserved */
/* 18 */
EXTERN TclFile		TclpMakeFile(Tcl_Channel channel, int direction);
/* 19 */
EXTERN TclFile		TclpOpenFile(const char *fname, int mode);
/* 20 */
EXTERN void		TclWinAddProcess(HANDLE hProcess, DWORD id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */

/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void		TclWinResetInterfaces(void);
/* 29 */
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
/* 0 */
EXTERN void		TclWinConvertError(unsigned int errCode);

/* 1 */
EXTERN void		TclWinConvertWSAError(unsigned int errCode);
/* 2 */
EXTERN Tcl_Channel	TclpCreateCommandChannel(TclFile readFile,
				TclFile writeFile, TclFile errorFile,
				int numPids, Tcl_Pid *pidPtr);
/* 3 */
EXTERN int		TclpCreatePipe(TclFile *readPipe, TclFile *writePipe);
/* 4 */
EXTERN void *		TclWinGetTclInstance(void);



/* Slot 5 is reserved */
/* 6 */
EXTERN unsigned short	TclWinNToHS(unsigned short ns);
/* 7 */
EXTERN int		TclWinSetSockOpt(void *s, int level, int optname,
				const char *optval, int optlen);
/* 8 */
EXTERN int		TclUnixWaitForFile(int fd, int mask, int timeout);
/* 9 */
EXTERN int		TclWinGetPlatformId(void);
/* 10 */
EXTERN Tcl_DirEntry *	TclpReaddir(DIR *dir);
/* 11 */
EXTERN struct tm *	TclpLocaltime_unix(const time_t *clock);
/* 12 */
EXTERN struct tm *	TclpGmtime_unix(const time_t *clock);
/* 13 */
194
195
196
197
198
199
200






















201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222

















223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276












277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323





























324
325
326
327
328
329
330
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);






















#endif /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    const struct TclIntPlatStubHooks *hooks;

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    void (*reserved5)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */

















#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    void (*tclWinConvertError) (unsigned long errCode); /* 0 */
    void (*tclWinConvertWSAError) (unsigned long errCode); /* 1 */
    struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char FAR *optval, int FAR *optlen); /* 3 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    void (*reserved5)(void);
    u_short (*tclWinNToHS) (u_short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char FAR *optval, int optlen); /* 7 */
    unsigned long (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    void (*reserved16)(void);
    void (*reserved17)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, unsigned long id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    char * (*tclpGetTZName) (int isdst); /* 23 */
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 0 */
    int (*tclpCloseFile) (TclFile file); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 4 */
    void (*reserved5)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 6 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    TclFile (*tclpCreateTempFile) (const char *contents); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */












#endif /* MACOSX */
} TclIntPlatStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
/* Slot 5 is reserved */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */





























#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclWinGetServByName \







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







|
|


|

|
|

|





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


|
|

|



|












|


|








|
|


|

|
|

|










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


















|
|
|
|




|
|

|
|
|
|


|
|










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







233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
EXTERN int		TclMacOSXMatchType(Tcl_Interp *interp,
				const char *pathName, const char *fileName,
				Tcl_StatBuf *statBufPtr,
				Tcl_GlobTypeData *types);
/* 19 */
EXTERN void		TclMacOSXNotifierAddRunLoopMode(
				const void *runLoopMode);
/* 20 */
EXTERN void		TclWinAddProcess(void *hProcess, unsigned int id);
/* Slot 21 is reserved */
/* 22 */
EXTERN TclFile		TclpCreateTempFile(const char *contents);
/* Slot 23 is reserved */
/* 24 */
EXTERN char *		TclWinNoBackslash(char *path);
/* Slot 25 is reserved */
/* 26 */
EXTERN void		TclWinSetInterfaces(int wide);
/* 27 */
EXTERN void		TclWinFlushDirtyChannels(void);
/* 28 */
EXTERN void		TclWinResetInterfaces(void);
/* 29 */
EXTERN int		TclWinCPUID(unsigned int index, unsigned int *regs);
/* 30 */
EXTERN void		TclGetAndDetachPids(Tcl_Interp *interp,
				Tcl_Channel chan);
/* 31 */
EXTERN int		TclpCloseFile(TclFile file);
#endif /* MACOSX */

typedef struct TclIntPlatStubs {
    int magic;
    const struct TclIntPlatStubHooks *hooks;

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    void (*tclWinConvertError) (unsigned int errCode); /* 0 */
    void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    void * (*tclWinGetTclInstance) (void); /* 4 */
    void (*reserved5)(void);
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (void *s, int level, int optname, const char *optval, int optlen); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    void (*reserved16)(void);
    void (*reserved17)(void);
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */
    int (*tclpCloseFile) (TclFile file); /* 31 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    void (*tclWinConvertError) (DWORD errCode); /* 0 */
    void (*tclWinConvertWSAError) (DWORD errCode); /* 1 */
    struct servent * (*tclWinGetServByName) (const char *nm, const char *proto); /* 2 */
    int (*tclWinGetSockOpt) (SOCKET s, int level, int optname, char *optval, int *optlen); /* 3 */
    HINSTANCE (*tclWinGetTclInstance) (void); /* 4 */
    void (*reserved5)(void);
    u_short (*tclWinNToHS) (u_short ns); /* 6 */
    int (*tclWinSetSockOpt) (SOCKET s, int level, int optname, const char *optval, int optlen); /* 7 */
    unsigned long (*tclpGetPid) (Tcl_Pid pid); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    void (*reserved10)(void);
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 11 */
    int (*tclpCloseFile) (TclFile file); /* 12 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 13 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 14 */
    int (*tclpCreateProcess) (Tcl_Interp *interp, int argc, const char **argv, TclFile inputFile, TclFile outputFile, TclFile errorFile, Tcl_Pid *pidPtr); /* 15 */
    void (*reserved16)(void);
    void (*reserved17)(void);
    TclFile (*tclpMakeFile) (Tcl_Channel channel, int direction); /* 18 */
    TclFile (*tclpOpenFile) (const char *fname, int mode); /* 19 */
    void (*tclWinAddProcess) (HANDLE hProcess, DWORD id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    void (*tclWinConvertError) (unsigned int errCode); /* 0 */
    void (*tclWinConvertWSAError) (unsigned int errCode); /* 1 */
    Tcl_Channel (*tclpCreateCommandChannel) (TclFile readFile, TclFile writeFile, TclFile errorFile, int numPids, Tcl_Pid *pidPtr); /* 2 */
    int (*tclpCreatePipe) (TclFile *readPipe, TclFile *writePipe); /* 3 */
    void * (*tclWinGetTclInstance) (void); /* 4 */
    void (*reserved5)(void);
    unsigned short (*tclWinNToHS) (unsigned short ns); /* 6 */
    int (*tclWinSetSockOpt) (void *s, int level, int optname, const char *optval, int optlen); /* 7 */
    int (*tclUnixWaitForFile) (int fd, int mask, int timeout); /* 8 */
    int (*tclWinGetPlatformId) (void); /* 9 */
    Tcl_DirEntry * (*tclpReaddir) (DIR *dir); /* 10 */
    struct tm * (*tclpLocaltime_unix) (const time_t *clock); /* 11 */
    struct tm * (*tclpGmtime_unix) (const time_t *clock); /* 12 */
    char * (*tclpInetNtoa) (struct in_addr addr); /* 13 */
    int (*tclUnixCopyFile) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr, int dontCopyAtts); /* 14 */
    int (*tclMacOSXGetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj **attributePtrPtr); /* 15 */
    int (*tclMacOSXSetFileAttribute) (Tcl_Interp *interp, int objIndex, Tcl_Obj *fileName, Tcl_Obj *attributePtr); /* 16 */
    int (*tclMacOSXCopyFileAttributes) (const char *src, const char *dst, const Tcl_StatBuf *statBufPtr); /* 17 */
    int (*tclMacOSXMatchType) (Tcl_Interp *interp, const char *pathName, const char *fileName, Tcl_StatBuf *statBufPtr, Tcl_GlobTypeData *types); /* 18 */
    void (*tclMacOSXNotifierAddRunLoopMode) (const void *runLoopMode); /* 19 */
    void (*tclWinAddProcess) (void *hProcess, unsigned int id); /* 20 */
    void (*reserved21)(void);
    TclFile (*tclpCreateTempFile) (const char *contents); /* 22 */
    void (*reserved23)(void);
    char * (*tclWinNoBackslash) (char *path); /* 24 */
    void (*reserved25)(void);
    void (*tclWinSetInterfaces) (int wide); /* 26 */
    void (*tclWinFlushDirtyChannels) (void); /* 27 */
    void (*tclWinResetInterfaces) (void); /* 28 */
    int (*tclWinCPUID) (unsigned int index, unsigned int *regs); /* 29 */
    void (*tclGetAndDetachPids) (Tcl_Interp *interp, Tcl_Channel chan); /* 30 */
    int (*tclpCloseFile) (TclFile file); /* 31 */
#endif /* MACOSX */
} TclIntPlatStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclIntPlatStubs *tclIntPlatStubsPtr;
#ifdef __cplusplus
}
#endif

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
/* Slot 5 is reserved */
#define TclWinNToHS \
	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
/* Slot 16 is reserved */
/* Slot 17 is reserved */
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 31 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclWinGetServByName \
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420





















421
422
423
424
425
426
427
428
429
430


431





















432
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
#define TclpGetTZName \
	(tclIntPlatStubsPtr->tclpGetTZName) /* 23 */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 0 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclpCreateProcess \
	(tclIntPlatStubsPtr->tclpCreateProcess) /* 4 */
/* Slot 5 is reserved */
#define TclpMakeFile \
	(tclIntPlatStubsPtr->tclpMakeFile) /* 6 */
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */





















#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
























#endif /* _TCLINTPLATDECLS */







|
<













|
|
|
|




|
|

|
|
|
|


|
|




















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










>
>

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

479
480
481
482
483
484
485
486

487
488
489
490
491
492
493
494
495
496
497
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
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
#define TclpOpenFile \
	(tclIntPlatStubsPtr->tclpOpenFile) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */

#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
#define TclWinConvertError \
	(tclIntPlatStubsPtr->tclWinConvertError) /* 0 */
#define TclWinConvertWSAError \
	(tclIntPlatStubsPtr->tclWinConvertWSAError) /* 1 */
#define TclpCreateCommandChannel \
	(tclIntPlatStubsPtr->tclpCreateCommandChannel) /* 2 */
#define TclpCreatePipe \
	(tclIntPlatStubsPtr->tclpCreatePipe) /* 3 */
#define TclWinGetTclInstance \
	(tclIntPlatStubsPtr->tclWinGetTclInstance) /* 4 */
/* Slot 5 is reserved */
#define TclWinNToHS \
	(tclIntPlatStubsPtr->tclWinNToHS) /* 6 */
#define TclWinSetSockOpt \
	(tclIntPlatStubsPtr->tclWinSetSockOpt) /* 7 */
#define TclUnixWaitForFile \
	(tclIntPlatStubsPtr->tclUnixWaitForFile) /* 8 */
#define TclWinGetPlatformId \
	(tclIntPlatStubsPtr->tclWinGetPlatformId) /* 9 */
#define TclpReaddir \
	(tclIntPlatStubsPtr->tclpReaddir) /* 10 */
#define TclpLocaltime_unix \
	(tclIntPlatStubsPtr->tclpLocaltime_unix) /* 11 */
#define TclpGmtime_unix \
	(tclIntPlatStubsPtr->tclpGmtime_unix) /* 12 */
#define TclpInetNtoa \
	(tclIntPlatStubsPtr->tclpInetNtoa) /* 13 */
#define TclUnixCopyFile \
	(tclIntPlatStubsPtr->tclUnixCopyFile) /* 14 */
#define TclMacOSXGetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXGetFileAttribute) /* 15 */
#define TclMacOSXSetFileAttribute \
	(tclIntPlatStubsPtr->tclMacOSXSetFileAttribute) /* 16 */
#define TclMacOSXCopyFileAttributes \
	(tclIntPlatStubsPtr->tclMacOSXCopyFileAttributes) /* 17 */
#define TclMacOSXMatchType \
	(tclIntPlatStubsPtr->tclMacOSXMatchType) /* 18 */
#define TclMacOSXNotifierAddRunLoopMode \
	(tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode) /* 19 */
#define TclWinAddProcess \
	(tclIntPlatStubsPtr->tclWinAddProcess) /* 20 */
/* Slot 21 is reserved */
#define TclpCreateTempFile \
	(tclIntPlatStubsPtr->tclpCreateTempFile) /* 22 */
/* Slot 23 is reserved */
#define TclWinNoBackslash \
	(tclIntPlatStubsPtr->tclWinNoBackslash) /* 24 */
/* Slot 25 is reserved */
#define TclWinSetInterfaces \
	(tclIntPlatStubsPtr->tclWinSetInterfaces) /* 26 */
#define TclWinFlushDirtyChannels \
	(tclIntPlatStubsPtr->tclWinFlushDirtyChannels) /* 27 */
#define TclWinResetInterfaces \
	(tclIntPlatStubsPtr->tclWinResetInterfaces) /* 28 */
#define TclWinCPUID \
	(tclIntPlatStubsPtr->tclWinCPUID) /* 29 */
#define TclGetAndDetachPids \
	(tclIntPlatStubsPtr->tclGetAndDetachPids) /* 30 */
#define TclpCloseFile \
	(tclIntPlatStubsPtr->tclpCloseFile) /* 31 */
#endif /* MACOSX */

#endif /* defined(USE_TCL_STUBS) */

/* !END!: Do not edit above this line. */

#undef TCL_STORAGE_CLASS
#define TCL_STORAGE_CLASS DLLIMPORT
#undef TclpLocaltime_unix
#undef TclpGmtime_unix
#undef TclWinConvertWSAError
#define TclWinConvertWSAError TclWinConvertError


#if !defined(__WIN32__) && defined(USE_TCL_STUBS)
#   ifdef __CYGWIN__
#	define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \
		CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \
		tclIntPlatStubsPtr->tclMacOSXGetFileAttribute)
#	define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \
	    int direction))) tclIntPlatStubsPtr->tclMacOSXMatchType)
#	define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \
	    tclIntPlatStubsPtr->tclMacOSXNotifierAddRunLoopMode)
#   else
#	define TclpCreateProcess ((int (*) _ANSI_ARGS_((Tcl_Interp *, int, \
		CONST char **, TclFile, TclFile, TclFile, Tcl_Pid *))) \
		tclIntPlatStubsPtr->tclWinGetTclInstance)
#	define TclpMakeFile ((TclFile (*) _ANSI_ARGS_((Tcl_Channel channel, \
	    int direction))) tclIntPlatStubsPtr->tclWinNToHS)
#	define TclpOpenFile ((TclFile (*) _ANSI_ARGS_((CONST char *, int))) \
	    tclIntPlatStubsPtr->tclWinNToHS)
#   endif
#endif

#endif /* _TCLINTPLATDECLS */

Changes to generic/tclLoad.c.

301
302
303
304
305
306
307






308
309
310
311
312
313
314
		splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
		Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
		pkgGuess = Tcl_GetString(pkgGuessPtr);
		if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
			&& (pkgGuess[2] == 'b')) {
		    pkgGuess += 3;
		}






		for (p = pkgGuess; *p != 0; p += offset) {
		    offset = Tcl_UtfToUniChar(p, &ch);
		    if ((ch > 0x100)
			    || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
				    || (UCHAR(ch) == '_'))) {
			break;
		    }







>
>
>
>
>
>







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
		splitPtr = Tcl_FSSplitPath(objv[1], &pElements);
		Tcl_ListObjIndex(NULL, splitPtr, pElements -1, &pkgGuessPtr);
		pkgGuess = Tcl_GetString(pkgGuessPtr);
		if ((pkgGuess[0] == 'l') && (pkgGuess[1] == 'i')
			&& (pkgGuess[2] == 'b')) {
		    pkgGuess += 3;
		}
#ifdef __CYGWIN__
		if ((pkgGuess[0] == 'c') && (pkgGuess[1] == 'y')
			&& (pkgGuess[2] == 'g')) {
		    pkgGuess += 3;
		}
#endif /* __CYGWIN__ */
		for (p = pkgGuess; *p != 0; p += offset) {
		    offset = Tcl_UtfToUniChar(p, &ch);
		    if ((ch > 0x100)
			    || !(isalpha(UCHAR(ch)) /* INTL: ISO only */
				    || (UCHAR(ch) == '_'))) {
			break;
		    }
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
	code = TCL_ERROR;
#endif
    }

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&tmp);
    if (!complain && code!=TCL_OK) {
	code = TCL_OK;
	Tcl_ResetResult(interp);
    }
    if (code == TCL_OK) {
#if 0
	/*
	 * Result of [unload] was not documented in TIP#100, so force to be
	 * the empty string by commenting this out. DKF.
	 */

	Tcl_Obj *resultObjPtr, *objPtr[2];

	/*
	 * Our result is the two reference counts.
	 */

	TclNewIntObj(objPtr[0], trustedRefCount);
	TclNewIntObj(objPtr[1], safeRefCount);
	if (objPtr[0] == NULL || objPtr[1] == NULL) {
	    if (objPtr[0]) {
		Tcl_DecrRefCount(objPtr[0]);
	    }
	    if (objPtr[1]) {
		Tcl_DecrRefCount(objPtr[1]);
	    }
	} else {
	    TclNewListObj(resultObjPtr, 2, objPtr);
	    if (resultObjPtr != NULL) {
		Tcl_SetObjResult(interp, resultObjPtr);
	    }
	}
#endif
    }
    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --







|



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







869
870
871
872
873
874
875
876
877
878
879






























880
881
882
883
884
885
886
	code = TCL_ERROR;
#endif
    }

  done:
    Tcl_DStringFree(&pkgName);
    Tcl_DStringFree(&tmp);
    if (!complain && (code != TCL_OK)) {
	code = TCL_OK;
	Tcl_ResetResult(interp);
    }






























    return code;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_StaticPackage --

Changes to generic/tclOO.c.

24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
    Tcl_ObjCmdProc *objProc;
    int flag;
} defineCmds[] = {
    {"constructor", TclOODefineConstructorObjCmd, 0},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
    {"destructor", TclOODefineDestructorObjCmd, 0},
    {"export", TclOODefineExportObjCmd, 0},
    {"filter", TclOODefineFilterObjCmd, 0},
    {"forward", TclOODefineForwardObjCmd, 0},
    {"method", TclOODefineMethodObjCmd, 0},
    {"mixin", TclOODefineMixinObjCmd, 0},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
    {"self", TclOODefineSelfObjCmd, 0},
    {"superclass", TclOODefineSuperclassObjCmd, 0},
    {"unexport", TclOODefineUnexportObjCmd, 0},
    {"variable", TclOODefineVariablesObjCmd, 0},
    {NULL, NULL, 0}
}, objdefCmds[] = {
    {"class", TclOODefineClassObjCmd, 1},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
    {"export", TclOODefineExportObjCmd, 1},
    {"filter", TclOODefineFilterObjCmd, 1},
    {"forward", TclOODefineForwardObjCmd, 1},
    {"method", TclOODefineMethodObjCmd, 1},
    {"mixin", TclOODefineMixinObjCmd, 1},
    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
    {"unexport", TclOODefineUnexportObjCmd, 1},
    {"variable", TclOODefineVariablesObjCmd, 1},
    {NULL, NULL, 0}
};

/*
 * What sort of size of things we like to allocate.
 */








<


<


<

<





<


<


<







24
25
26
27
28
29
30

31
32

33
34

35

36
37
38
39
40

41
42

43
44

45
46
47
48
49
50
51
    Tcl_ObjCmdProc *objProc;
    int flag;
} defineCmds[] = {
    {"constructor", TclOODefineConstructorObjCmd, 0},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 0},
    {"destructor", TclOODefineDestructorObjCmd, 0},
    {"export", TclOODefineExportObjCmd, 0},

    {"forward", TclOODefineForwardObjCmd, 0},
    {"method", TclOODefineMethodObjCmd, 0},

    {"renamemethod", TclOODefineRenameMethodObjCmd, 0},
    {"self", TclOODefineSelfObjCmd, 0},

    {"unexport", TclOODefineUnexportObjCmd, 0},

    {NULL, NULL, 0}
}, objdefCmds[] = {
    {"class", TclOODefineClassObjCmd, 1},
    {"deletemethod", TclOODefineDeleteMethodObjCmd, 1},
    {"export", TclOODefineExportObjCmd, 1},

    {"forward", TclOODefineForwardObjCmd, 1},
    {"method", TclOODefineMethodObjCmd, 1},

    {"renamemethod", TclOODefineRenameMethodObjCmd, 1},
    {"unexport", TclOODefineUnexportObjCmd, 1},

    {NULL, NULL, 0}
};

/*
 * What sort of size of things we like to allocate.
 */

75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
static void		DeletedHelpersNamespace(ClientData clientData);
static int		FinalizeAlloc(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeNext(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeObjectCall(ClientData data[],
			    Tcl_Interp *interp, int result);
static void		InitFoundation(Tcl_Interp *interp);
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);







|







68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
static void		DeletedHelpersNamespace(ClientData clientData);
static int		FinalizeAlloc(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeNext(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		FinalizeObjectCall(ClientData data[],
			    Tcl_Interp *interp, int result);
static int		InitFoundation(Tcl_Interp *interp);
static void		KillFoundation(ClientData clientData,
			    Tcl_Interp *interp);
static void		MyDeleted(ClientData clientData);
static void		ObjectNamespaceDeleted(ClientData clientData);
static void		ObjectRenamedTrace(ClientData clientData,
			    Tcl_Interp *interp, const char *oldName,
			    const char *newName, int flags);
125
126
127
128
129
130
131




132

133
134
135
136
137













































































138
139
140
141
142
143
144
145
146














147
148
149
150
151
152
153
}, clsMethods[] = {
    DCM("create", 1,	TclOO_Class_Create),
    DCM("new", 1,	TclOO_Class_New),
    DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
    {NULL, 0, {0, NULL, NULL, NULL, NULL}}
};





static char initScript[] =

    "package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
    "namespace eval ::oo { variable version " TCLOO_VERSION " };"
    "namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/*     "tcl_findLibrary tcloo $oo::version $oo::version" */
/*     " tcloo.tcl OO_LIBRARY oo::library;"; */














































































MODULE_SCOPE const TclOOStubs tclOOStubs;

/*
 * Convenience macro for getting the foundation from an interpreter.
 */

#define GetFoundation(interp) \
	((Foundation *)((Interp *)(interp))->objectFoundation)















/*
 * ----------------------------------------------------------------------
 *
 * TclOOInit --
 *
 *	Called to initialise the OO system within an interpreter.







>
>
>
>
|
>
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









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







118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
}, clsMethods[] = {
    DCM("create", 1,	TclOO_Class_Create),
    DCM("new", 1,	TclOO_Class_New),
    DCM("createWithNamespace", 0, TclOO_Class_CreateNs),
    {NULL, 0, {0, NULL, NULL, NULL, NULL}}
};

/*
 * Scripted parts of TclOO. First, the master script (cannot be outside this
 * file).
 */

static const char *initScript =
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The body of the constructor for oo::class.
 */

static const char *classConstructorBody =
"set script [list ::oo::define [self] $definitionScript];"
"lassign [::oo::UpCatch $script] msg opts;"
"if {[dict get $opts -code] == 1} {"
"    dict set opts -errorline 0xDeadBeef"
"};"
"return -options $opts $msg;";

/*
 * The scripted part of the definitions of slots.
 */

static const char *slotScript =
"::oo::define ::oo::Slot {\n"
"    method Get {} {error unimplemented}\n"
"    method Set list {error unimplemented}\n"
"    method -set args {\n"
"        uplevel 1 [list [namespace which my] Set $args]\n"
"    }\n"
"    method -append args {\n"
"        uplevel 1 [list [namespace which my] Set [list"
"                {*}[uplevel 1 [list [namespace which my] Get]] {*}$args]]\n"
"    }\n"
"    method -clear {} {uplevel 1 [list [namespace which my] Set {}]}\n"
"    forward --default-operation my -append\n"
"    method unknown {args} {\n"
"        set def --default-operation\n"
"        if {[llength $args] == 0} {\n"
"            return [uplevel 1 [list [namespace which my] $def]]\n"
"        } elseif {![string match -* [lindex $args 0]]} {\n"
"            return [uplevel 1 [list [namespace which my] $def {*}$args]]\n"
"        }\n"
"        next {*}$args\n"
"    }\n"
"    export -set -append -clear\n"
"    unexport unknown destroy\n"
"}\n"
"::oo::objdefine ::oo::define::superclass forward --default-operation my -set\n"
"::oo::objdefine ::oo::define::mixin forward --default-operation my -set\n"
"::oo::objdefine ::oo::objdefine::mixin forward --default-operation my -set\n";

/*
 * The body of the <cloned> method of oo::object.
 */

static const char *clonedBody =
"foreach p [info procs [info object namespace $originObject]::*] {"
"    set args [info args $p];"
"    set idx -1;"
"    foreach a $args {"
"        lset args [incr idx] "
"            [if {[info default $p $a d]} {list $a $d} {list $a}]"
"    };"
"    set b [info body $p];"
"    set p [namespace tail $p];"
"    proc $p $args $b;"
"};"
"foreach v [info vars [info object namespace $originObject]::*] {"
"    upvar 0 $v vOrigin;"
"    namespace upvar [namespace current] [namespace tail $v] vNew;"
"    if {[info exists vOrigin]} {"
"        if {[array exists vOrigin]} {"
"            array set vNew [array get vOrigin];"
"        } else {"
"            set vNew $vOrigin;"
"        }"
"    }"
"}";

/*
 * The actual definition of the variable holding the TclOO stub table.
 */

MODULE_SCOPE const TclOOStubs tclOOStubs;

/*
 * Convenience macro for getting the foundation from an interpreter.
 */

#define GetFoundation(interp) \
	((Foundation *)((Interp *)(interp))->objectFoundation)

/*
 * Macros to make inspecting into the guts of an object cleaner.
 *
 * The ocPtr parameter (only in these macros) is assumed to work fine with
 * either an oPtr or a classPtr. Note that the roots oo::object and oo::class
 * have _both_ their object and class flags tagged with ROOT_OBJECT and
 * ROOT_CLASS respectively.
 */

#define Deleted(oPtr)		(((Object *)(oPtr))->command == NULL)
#define IsRootObject(ocPtr)	((ocPtr)->flags & ROOT_OBJECT)
#define IsRootClass(ocPtr)	((ocPtr)->flags & ROOT_CLASS)
#define IsRoot(ocPtr)		((ocPtr)->flags & (ROOT_OBJECT|ROOT_CLASS))

/*
 * ----------------------------------------------------------------------
 *
 * TclOOInit --
 *
 *	Called to initialise the OO system within an interpreter.
166
167
168
169
170
171
172
173


174
175
176
177
178
179
180
TclOOInit(
    Tcl_Interp *interp)		/* The interpreter to install into. */
{
    /*
     * Build the core of the OO system.
     */

    InitFoundation(interp);



    /*
     * Run our initialization script and, if that works, declare the package
     * to be fully provided.
     */

    if (Tcl_Eval(interp, initScript) != TCL_OK) {







|
>
>







255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
TclOOInit(
    Tcl_Interp *interp)		/* The interpreter to install into. */
{
    /*
     * Build the core of the OO system.
     */

    if (InitFoundation(interp) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Run our initialization script and, if that works, declare the package
     * to be fully provided.
     */

    if (Tcl_Eval(interp, initScript) != TCL_OK) {
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 *	Set up the core of the OO core class system. This is a structure
 *	holding references to the magical bits that need to be known about in
 *	other places, plus the oo::object and oo::class classes.
 *
 * ----------------------------------------------------------------------
 */

static void
InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = ckalloc(sizeof(Foundation));







|







301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
 *	Set up the core of the OO core class system. This is a structure
 *	holding references to the magical bits that need to be known about in
 *	other places, plus the oo::object and oo::class classes.
 *
 * ----------------------------------------------------------------------
 */

static int
InitFoundation(
    Tcl_Interp *interp)
{
    static Tcl_ThreadDataKey tsdKey;
    ThreadLocalData *tsdPtr =
	    Tcl_GetThreadData(&tsdKey, sizeof(ThreadLocalData));
    Foundation *fPtr = ckalloc(sizeof(Foundation));
241
242
243
244
245
246
247
248
249
250

251
252
253

254
255
256
257
258
259
260
261
262
263
264
265
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    fPtr->epoch = 0;
    fPtr->tsdPtr = tsdPtr;
    fPtr->unknownMethodNameObj = Tcl_NewStringObj("unknown", -1);
    fPtr->constructorName = Tcl_NewStringObj("<constructor>", -1);
    fPtr->destructorName = Tcl_NewStringObj("<destructor>", -1);

    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
    Tcl_IncrRefCount(fPtr->constructorName);
    Tcl_IncrRefCount(fPtr->destructorName);

    Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
	    TclOONRUpcatch, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
	    TclOOUnknownDefinition, NULL, NULL);
    namePtr = Tcl_NewStringObj("::oo::UnknownDefinition", -1);
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */








|
|
|
>



>




|







332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
	    DeletedDefineNamespace);
    fPtr->objdefNs = Tcl_CreateNamespace(interp, "::oo::objdefine", fPtr,
	    DeletedObjdefNamespace);
    fPtr->helpersNs = Tcl_CreateNamespace(interp, "::oo::Helpers", fPtr,
	    DeletedHelpersNamespace);
    fPtr->epoch = 0;
    fPtr->tsdPtr = tsdPtr;
    TclNewLiteralStringObj(fPtr->unknownMethodNameObj, "unknown");
    TclNewLiteralStringObj(fPtr->constructorName, "<constructor>");
    TclNewLiteralStringObj(fPtr->destructorName, "<destructor>");
    TclNewLiteralStringObj(fPtr->clonedName, "<cloned>");
    Tcl_IncrRefCount(fPtr->unknownMethodNameObj);
    Tcl_IncrRefCount(fPtr->constructorName);
    Tcl_IncrRefCount(fPtr->destructorName);
    Tcl_IncrRefCount(fPtr->clonedName);
    Tcl_NRCreateCommand(interp, "::oo::UpCatch", TclOOUpcatchCmd,
	    TclOONRUpcatch, NULL, NULL);
    Tcl_CreateObjCommand(interp, "::oo::UnknownDefinition",
	    TclOOUnknownDefinition, NULL, NULL);
    TclNewLiteralStringObj(namePtr, "::oo::UnknownDefinition");
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->defineNs, namePtr);
    Tcl_SetNamespaceUnknownHandler(interp, fPtr->objdefNs, namePtr);

    /*
     * Create the subcommands in the oo::define and oo::objdefine spaces.
     */

288
289
290
291
292
293
294

295
296
297
298
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315












316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345

    fPtr->objectCls = AllocClass(interp,
	    AllocObject(interp, "::oo::object", NULL));
    fPtr->classCls = AllocClass(interp,
	    AllocObject(interp, "::oo::class", NULL));
    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;

    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;
    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;

    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
    AddRef(fPtr->objectCls->thisPtr);
    AddRef(fPtr->objectCls);

    /*
     * Basic method declarations for the core classes.
     */

    for (i=0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i=0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }













    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     *
     * The 0xDeadBeef is a special signal to the errorInfo logger that is used
     * by constructors that stops it from generating extra error information
     * that is confusing.
     */

    namePtr = Tcl_NewStringObj("new", -1);
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);

    argsPtr = Tcl_NewStringObj("{definitionScript {}}", -1);
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(
	    "set script [list ::oo::define [self] $definitionScript];"
	    "lassign [::oo::UpCatch $script] msg opts\n"
	    "if {[dict get $opts -code] == 1} {"
	    "    dict set opts -errorline 0xDeadBeef\n"
	    "}\n"
	    "return -options $opts $msg", -1);
    fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
    Tcl_DecrRefCount(argsPtr);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.







>





>
















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










|



|

|
<
<
<
<
<
<







381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439






440
441
442
443
444
445
446

    fPtr->objectCls = AllocClass(interp,
	    AllocObject(interp, "::oo::object", NULL));
    fPtr->classCls = AllocClass(interp,
	    AllocObject(interp, "::oo::class", NULL));
    fPtr->objectCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->objectCls->thisPtr->flags |= ROOT_OBJECT;
    fPtr->objectCls->flags |= ROOT_OBJECT;
    fPtr->objectCls->superclasses.num = 0;
    ckfree(fPtr->objectCls->superclasses.list);
    fPtr->objectCls->superclasses.list = NULL;
    fPtr->classCls->thisPtr->selfCls = fPtr->classCls;
    fPtr->classCls->thisPtr->flags |= ROOT_CLASS;
    fPtr->classCls->flags |= ROOT_CLASS;
    TclOOAddToInstances(fPtr->objectCls->thisPtr, fPtr->classCls);
    TclOOAddToInstances(fPtr->classCls->thisPtr, fPtr->classCls);
    AddRef(fPtr->objectCls->thisPtr);
    AddRef(fPtr->objectCls);

    /*
     * Basic method declarations for the core classes.
     */

    for (i=0 ; objMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->objectCls, &objMethods[i]);
    }
    for (i=0 ; clsMethods[i].name ; i++) {
	TclOONewBasicMethod(interp, fPtr->classCls, &clsMethods[i]);
    }

    /*
     * Create the default <cloned> method implementation, used when 'oo::copy'
     * is called to finish the copying of one object to another.
     */

    TclNewLiteralStringObj(argsPtr, "originObject");
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(clonedBody, -1);
    TclOONewProcMethod(interp, fPtr->objectCls, 0, fPtr->clonedName, argsPtr,
	    bodyPtr, NULL);
    Tcl_DecrRefCount(argsPtr);

    /*
     * Finish setting up the class of classes by marking the 'new' method as
     * private; classes, unlike general objects, must have explicit names. We
     * also need to create the constructor for classes.
     *
     * The 0xDeadBeef is a special signal to the errorInfo logger that is used
     * by constructors that stops it from generating extra error information
     * that is confusing.
     */

    TclNewLiteralStringObj(namePtr, "new");
    Tcl_NewInstanceMethod(interp, (Tcl_Object) fPtr->classCls->thisPtr,
	    namePtr /* keeps ref */, 0 /* ==private */, NULL, NULL);

    TclNewLiteralStringObj(argsPtr, "{definitionScript {}}");
    Tcl_IncrRefCount(argsPtr);
    bodyPtr = Tcl_NewStringObj(classConstructorBody, -1);






    fPtr->classCls->constructorPtr = TclOONewProcMethod(interp,
	    fPtr->classCls, 0, NULL, argsPtr, bodyPtr, NULL);
    Tcl_DecrRefCount(argsPtr);

    /*
     * Create non-object commands and plug ourselves into the Tcl [info]
     * ensemble.
353
354
355
356
357
358
359









360
361
362
363
364
365
366
	    NULL);
    Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL);
    TclOOInitInfo(interp);









}

/*
 * ----------------------------------------------------------------------
 *
 * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
 *







>
>
>
>
>
>
>
>
>







454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
	    NULL);
    Tcl_CreateObjCommand(interp, "::oo::define", TclOODefineObjCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand(interp, "::oo::objdefine", TclOOObjDefObjCmd, NULL,
	    NULL);
    Tcl_CreateObjCommand(interp, "::oo::copy", TclOOCopyObjectCmd, NULL,NULL);
    TclOOInitInfo(interp);

    /*
     * Now make the class of slots.
     */

    if (TclOODefineSlots(fPtr) != TCL_OK) {
	return TCL_ERROR;
    }
    return Tcl_Eval(interp, slotScript);
}

/*
 * ----------------------------------------------------------------------
 *
 * DeletedDefineNamespace, DeletedObjdefNamespace, DeletedHelpersNamespace --
 *
418
419
420
421
422
423
424

425
426
427
428
429
430
431
    Foundation *fPtr = GetFoundation(interp);

    DelRef(fPtr->objectCls->thisPtr);
    DelRef(fPtr->objectCls);
    Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
    Tcl_DecrRefCount(fPtr->constructorName);
    Tcl_DecrRefCount(fPtr->destructorName);

    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --







>







528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
    Foundation *fPtr = GetFoundation(interp);

    DelRef(fPtr->objectCls->thisPtr);
    DelRef(fPtr->objectCls);
    Tcl_DecrRefCount(fPtr->unknownMethodNameObj);
    Tcl_DecrRefCount(fPtr->constructorName);
    Tcl_DecrRefCount(fPtr->destructorName);
    Tcl_DecrRefCount(fPtr->clonedName);
    ckfree(fPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * AllocObject --
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
    ClientData clientData,	/* The object being deleted. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    const char *oldName,	/* What the object was (last) called. */
    const char *newName,	/* Always NULL. */
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = clientData;
    Class *clsPtr;
    CallContext *contextPtr;

    /*
     * If this is a rename and not a delete of the object, we just flush the
     * cache of the object name.
     */

    if (flags & TCL_TRACE_RENAME) {







|
<







776
777
778
779
780
781
782
783

784
785
786
787
788
789
790
    ClientData clientData,	/* The object being deleted. */
    Tcl_Interp *interp,		/* The interpreter containing the object. */
    const char *oldName,	/* What the object was (last) called. */
    const char *newName,	/* Always NULL. */
    int flags)			/* Why was the object deleted? */
{
    Object *oPtr = clientData;
    Foundation *fPtr = oPtr->fPtr;


    /*
     * If this is a rename and not a delete of the object, we just flush the
     * cache of the object name.
     */

    if (flags & TCL_TRACE_RENAME) {
698
699
700
701
702
703
704




705
706
707
708
709

710
711
712
713
714
715


716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766




767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785

786
787
788

789
790


791












792




793




















































































794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855

856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876




877
878
879
880
881
882
883
884
885
886



887
888
889
890
891
892
893
894
895
896
     * We also do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
     */

    AddRef(oPtr);




    oPtr->command = NULL;
    oPtr->flags |= OBJECT_DELETED;

    if (!(oPtr->flags & DESTRUCTOR_CALLED) && (!Tcl_InterpDeleted(interp)
	    || (oPtr->flags & (ROOT_OBJECT|ROOT_CLASS)))) {

	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
	oPtr->flags |= DESTRUCTOR_CALLED;
	if (contextPtr != NULL) {
	    int result;
	    Tcl_InterpState state;



	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
		    contextPtr, 0, NULL);
	    if (result != TCL_OK) {
		Tcl_BackgroundError(interp);
	    }
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * OK, the destructor's been run. Time to splat the class data (if any)
     * and nuke the namespace (which triggers the final crushing of the object
     * structure itself).
     *
     * The class of classes needs some special care; if it is deleted (and
     * we're not killing the whole interpreter) we force the delete of the
     * class of objects now as well. Due to the incestuous nature of those two
     * classes, if one goes the other must too and yet the tangle can
     * sometimes not go away automatically; we force it here. [Bug 2962664]
     */

    if (!Tcl_InterpDeleted(interp)) {
	if ((oPtr->flags & ROOT_OBJECT) && oPtr->fPtr->classCls != NULL) {
	    Tcl_DeleteCommandFromToken(interp,
		    oPtr->fPtr->classCls->thisPtr->command);
	} else if (oPtr->flags & ROOT_CLASS) {
	    oPtr->fPtr->classCls = NULL;
	}
    }

    clsPtr = oPtr->classPtr;
    if (clsPtr != NULL) {
	AddRef(clsPtr);
	ReleaseClassContents(interp, oPtr);
    }

    /*
     * The namespace is only deleted if it hasn't already been deleted. [Bug
     * 2950259]
     */

    if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
	Tcl_DeleteNamespace(oPtr->namespacePtr);
    }
    if (clsPtr) {
	DelRef(clsPtr);
    }




    DelRef(oPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

static void
ReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{

    int i, n;
    Class *clsPtr = oPtr->classPtr, **list;
    Object **insts;


    /*


     * Must empty list before processing the members of the list so that












     * things happen in the correct order even if something tries to play




     * fast-and-loose.




















































































     */

    list = clsPtr->mixinSubs.list;
    n = clsPtr->mixinSubs.num;
    clsPtr->mixinSubs.list = NULL;
    clsPtr->mixinSubs.num = 0;
    clsPtr->mixinSubs.size = 0;
    for (i=0 ; i<n ; i++) {
	AddRef(list[i]);
	AddRef(list[i]->thisPtr);
    }
    for (i=0 ; i<n ; i++) {
	if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) {
	    list[i]->thisPtr->flags |= OBJECT_DELETED;
	    Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
	}
	DelRef(list[i]->thisPtr);
	DelRef(list[i]);
    }
    if (list != NULL) {
	ckfree(list);
    }

    list = clsPtr->subclasses.list;
    n = clsPtr->subclasses.num;
    clsPtr->subclasses.list = NULL;
    clsPtr->subclasses.num = 0;
    clsPtr->subclasses.size = 0;
    for (i=0 ; i<n ; i++) {
	AddRef(list[i]);
	AddRef(list[i]->thisPtr);
    }
    for (i=0 ; i<n ; i++) {
	if (!(list[i]->thisPtr->flags & OBJECT_DELETED)) {
	    list[i]->thisPtr->flags |= OBJECT_DELETED;
	    Tcl_DeleteCommandFromToken(interp, list[i]->thisPtr->command);
	}
	DelRef(list[i]->thisPtr);
	DelRef(list[i]);
    }
    if (list != NULL) {
	ckfree(list);
    }

    insts = clsPtr->instances.list;
    n = clsPtr->instances.num;
    clsPtr->instances.list = NULL;
    clsPtr->instances.num = 0;
    clsPtr->instances.size = 0;
    for (i=0 ; i<n ; i++) {
	AddRef(insts[i]);
    }
    for (i=0 ; i<n ; i++) {
	if (!(insts[i]->flags & OBJECT_DELETED)) {
	    insts[i]->flags |= OBJECT_DELETED;
	    Tcl_DeleteCommandFromToken(interp, insts[i]->command);
	}
	DelRef(insts[i]);
    }
    if (insts != NULL) {
	ckfree(insts);
    }


    if (clsPtr->constructorChainPtr) {
	TclOODeleteChain(clsPtr->constructorChainPtr);
	clsPtr->constructorChainPtr = NULL;
    }
    if (clsPtr->destructorChainPtr) {
	TclOODeleteChain(clsPtr->destructorChainPtr);
	clsPtr->destructorChainPtr = NULL;
    }
    if (clsPtr->classChainCache) {
	FOREACH_HASH_DECLS;
	CallChain *callPtr;

	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	ckfree(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }





    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.num = 0;
    }





    if (clsPtr->metadataPtr != NULL) {
	FOREACH_HASH_DECLS;
	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);







>
>
>
>

<

|
<
>
|
<
<
|
|

>
>


















|

|




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











|
|

>
>
>
>



















>
|
|
|
>


>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
|
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


<
<
<
<
<
<
<
|
<
<
<
<
|
|
<
<
|
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
>










<










>
>
>
>










>
>
>


<







808
809
810
811
812
813
814
815
816
817
818
819

820
821

822
823


824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856



857
858
859
860


861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011







1012




1013
1014


1015



1016




















1017


















1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028

1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057

1058
1059
1060
1061
1062
1063
1064
     * We also do not run destructors on the core class objects when the
     * interpreter is being deleted; their incestuous nature causes problems
     * in that case when the destructor is partially deleted before the uses
     * of it have gone. [Bug 2949397]
     */

    AddRef(oPtr);
    AddRef(fPtr->classCls);
    AddRef(fPtr->objectCls);
    AddRef(fPtr->classCls->thisPtr);
    AddRef(fPtr->objectCls->thisPtr);
    oPtr->command = NULL;


    if (!(oPtr->flags & DESTRUCTOR_CALLED) && !Tcl_InterpDeleted(interp)) {

	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);


	int result;
	Tcl_InterpState state;

	oPtr->flags |= DESTRUCTOR_CALLED;
	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext,
		    contextPtr, 0, NULL);
	    if (result != TCL_OK) {
		Tcl_BackgroundError(interp);
	    }
	    Tcl_RestoreInterpState(interp, state);
	    TclOODeleteContext(contextPtr);
	}
    }

    /*
     * OK, the destructor's been run. Time to splat the class data (if any)
     * and nuke the namespace (which triggers the final crushing of the object
     * structure itself).
     *
     * The class of objects needs some special care; if it is deleted (and
     * we're not killing the whole interpreter) we force the delete of the
     * class of classes now as well. Due to the incestuous nature of those two
     * classes, if one goes the other must too and yet the tangle can
     * sometimes not go away automatically; we force it here. [Bug 2962664]
     */

    if (!Tcl_InterpDeleted(interp) && IsRootObject(oPtr)
	    && !Deleted(fPtr->classCls->thisPtr)) {
	Tcl_DeleteCommandFromToken(interp, fPtr->classCls->thisPtr->command);



    }

    if (oPtr->classPtr != NULL) {
	AddRef(oPtr->classPtr);


	ReleaseClassContents(interp, oPtr);
    }

    /*
     * The namespace is only deleted if it hasn't already been deleted. [Bug
     * 2950259]
     */

    if (((Namespace *) oPtr->namespacePtr)->earlyDeleteProc != NULL) {
	Tcl_DeleteNamespace(oPtr->namespacePtr);
    }
    if (oPtr->classPtr) {
	DelRef(oPtr->classPtr);
    }
    DelRef(fPtr->classCls->thisPtr);
    DelRef(fPtr->objectCls->thisPtr);
    DelRef(fPtr->classCls);
    DelRef(fPtr->objectCls);
    DelRef(oPtr);
}

/*
 * ----------------------------------------------------------------------
 *
 * ReleaseClassContents --
 *
 *	Tear down the special class data structure, including deleting all
 *	dependent classes and objects.
 *
 * ----------------------------------------------------------------------
 */

static void
ReleaseClassContents(
    Tcl_Interp *interp,		/* The interpreter containing the class. */
    Object *oPtr)		/* The object representing the class. */
{
    FOREACH_HASH_DECLS;
    int i;
    Class *clsPtr = oPtr->classPtr, *mixinSubclassPtr, *subclassPtr;
    Object *instancePtr;
    Foundation *fPtr = oPtr->fPtr;

    /*
     * Sanity check!
     */

    if (!Deleted(oPtr)) {
	if (IsRootClass(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::class");
	} else if (IsRootObject(oPtr)) {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "::oo::object");
	} else {
	    Tcl_Panic("deleting class structure for non-deleted %s",
		    "general object");
	}
    }

    /*
     * Lock a number of dependent objects until we've stopped putting our
     * fingers in them.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
	if (mixinSubclassPtr != NULL) {
	    AddRef(mixinSubclassPtr);
	    AddRef(mixinSubclassPtr->thisPtr);
	}
    }
    FOREACH(subclassPtr, clsPtr->subclasses) {
	if (subclassPtr != NULL && !IsRoot(subclassPtr)) {
	    AddRef(subclassPtr);
	    AddRef(subclassPtr->thisPtr);
	}
    }
    if (!IsRootClass(oPtr)) {
	FOREACH(instancePtr, clsPtr->instances) {
	    if (instancePtr != NULL && !IsRoot(instancePtr)) {
		AddRef(instancePtr);
	    }
	}
    }

    /*
     * Squelch classes that this class has been mixed into.
     */

    FOREACH(mixinSubclassPtr, clsPtr->mixinSubs) {
	if (mixinSubclassPtr == NULL) {
	    continue;
	}
	if (!Deleted(mixinSubclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp,
		    mixinSubclassPtr->thisPtr->command);
	}
	DelRef(mixinSubclassPtr->thisPtr);
	DelRef(mixinSubclassPtr);
    }
    if (clsPtr->mixinSubs.list != NULL) {
	ckfree(clsPtr->mixinSubs.list);
	clsPtr->mixinSubs.list = NULL;
	clsPtr->mixinSubs.num = 0;
    }

    /*
     * Squelch subclasses of this class.
     */

    FOREACH(subclassPtr, clsPtr->subclasses) {
	if (subclassPtr == NULL || IsRoot(subclassPtr)) {
	    continue;
	}
	if (!Deleted(subclassPtr->thisPtr)) {
	    Tcl_DeleteCommandFromToken(interp, subclassPtr->thisPtr->command);
	}
	DelRef(subclassPtr->thisPtr);
	DelRef(subclassPtr);
    }
    if (clsPtr->subclasses.list != NULL) {
	ckfree(clsPtr->subclasses.list);
	clsPtr->subclasses.list = NULL;
	clsPtr->subclasses.num = 0;
    }

    /*
     * Squelch instances of this class (includes objects we're mixed into).
     */

    if (!IsRootClass(oPtr)) {
	FOREACH(instancePtr, clsPtr->instances) {
	    if (instancePtr == NULL || IsRoot(instancePtr)) {
		continue;
	    }
	    if (!Deleted(instancePtr)) {
		Tcl_DeleteCommandFromToken(interp, instancePtr->command);
	    }
	    DelRef(instancePtr);
	}
    }
    if (clsPtr->instances.list != NULL) {
	ckfree(clsPtr->instances.list);
	clsPtr->instances.list = NULL;
	clsPtr->instances.num = 0;
    }

    /*
     * Special: We delete these after everything else.
     */








    if (IsRootClass(oPtr) && !Deleted(fPtr->objectCls->thisPtr)) {




	Tcl_DeleteCommandFromToken(interp, fPtr->objectCls->thisPtr->command);
    }






    /*




















     * Squelch method implementation chain caches.


















     */

    if (clsPtr->constructorChainPtr) {
	TclOODeleteChain(clsPtr->constructorChainPtr);
	clsPtr->constructorChainPtr = NULL;
    }
    if (clsPtr->destructorChainPtr) {
	TclOODeleteChain(clsPtr->destructorChainPtr);
	clsPtr->destructorChainPtr = NULL;
    }
    if (clsPtr->classChainCache) {

	CallChain *callPtr;

	FOREACH_HASH_VALUE(callPtr, clsPtr->classChainCache) {
	    TclOODeleteChain(callPtr);
	}
	Tcl_DeleteHashTable(clsPtr->classChainCache);
	ckfree(clsPtr->classChainCache);
	clsPtr->classChainCache = NULL;
    }

    /*
     * Squelch our filter list.
     */

    if (clsPtr->filters.num) {
	Tcl_Obj *filterObj;

	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
	ckfree(clsPtr->filters.list);
	clsPtr->filters.num = 0;
    }

    /*
     * Squelch our metadata.
     */

    if (clsPtr->metadataPtr != NULL) {

	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
	    metadataTypePtr->deleteProc(value);
	}
	Tcl_DeleteHashTable(clsPtr->metadataPtr);
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
				 * being deleted. */
{
    Object *oPtr = clientData;
    FOREACH_HASH_DECLS;
    Class *clsPtr = oPtr->classPtr, *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    int i, preserved = !(oPtr->flags & OBJECT_DELETED);

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the commands that refer to the object at this point (if
     * they still exist) because otherwise their references to the object
     * point into freed memory, allowing crashes.
     */

    oPtr->flags |= OBJECT_DELETED;
    if (oPtr->command) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }
    if (oPtr->myCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);
    }
    if (preserved) {
	AddRef(oPtr);
	if (clsPtr != NULL) {
	    AddRef(clsPtr);
	    ReleaseClassContents(NULL, oPtr);
	}
    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    if (!(oPtr->flags & ROOT_OBJECT)) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
    }

    FOREACH(mixinPtr, oPtr->mixins) {
	TclOORemoveFromInstances(oPtr, mixinPtr);
    }
    if (i) {







|








<





<
<
<
<
<
<
<







|







1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101

1102
1103
1104
1105
1106







1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
				 * being deleted. */
{
    Object *oPtr = clientData;
    FOREACH_HASH_DECLS;
    Class *clsPtr = oPtr->classPtr, *mixinPtr;
    Method *mPtr;
    Tcl_Obj *filterObj, *variableObj;
    int i;

    /*
     * Instruct everyone to no longer use any allocated fields of the object.
     * Also delete the commands that refer to the object at this point (if
     * they still exist) because otherwise their references to the object
     * point into freed memory, allowing crashes.
     */


    if (oPtr->command) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->command);
    }
    if (oPtr->myCommand) {
	Tcl_DeleteCommandFromToken(oPtr->fPtr->interp, oPtr->myCommand);







    }

    /*
     * Splice the object out of its context. After this, we must *not* call
     * methods on the object.
     */

    if (!IsRootObject(oPtr)) {
	TclOORemoveFromInstances(oPtr, oPtr->selfCls);
    }

    FOREACH(mixinPtr, oPtr->mixins) {
	TclOORemoveFromInstances(oPtr, mixinPtr);
    }
    if (i) {
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014

1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	ckfree(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    if (clsPtr != NULL) {
	Class *superPtr;

	if (clsPtr->metadataPtr != NULL) {
	    Tcl_ObjectMetadataType *metadataTypePtr;
	    ClientData value;


	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		metadataTypePtr->deleteProc(value);
	    }
	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
	    ckfree(clsPtr->metadataPtr);
	    clsPtr->metadataPtr = NULL;
	}

	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
	if (i) {
	    ckfree(clsPtr->filters.list);
	    clsPtr->filters.num = 0;
	}
	FOREACH(mixinPtr, clsPtr->mixins) {
	    if (!(mixinPtr->thisPtr->flags & OBJECT_DELETED)) {
		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
	    }
	}
	if (i) {
	    ckfree(clsPtr->mixins.list);
	    clsPtr->mixins.num = 0;
	}
	FOREACH(superPtr, clsPtr->superclasses) {
	    if (!(superPtr->thisPtr->flags & OBJECT_DELETED)) {
		TclOORemoveFromSubclasses(clsPtr, superPtr);
	    }
	}
	if (i) {
	    ckfree(clsPtr->superclasses.list);
	    clsPtr->superclasses.num = 0;
	}







<
<
|
|

>
















|








|







1163
1164
1165
1166
1167
1168
1169


1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
	Tcl_DeleteHashTable(oPtr->metadataPtr);
	ckfree(oPtr->metadataPtr);
	oPtr->metadataPtr = NULL;
    }

    if (clsPtr != NULL) {
	Class *superPtr;


	Tcl_ObjectMetadataType *metadataTypePtr;
	ClientData value;

	if (clsPtr->metadataPtr != NULL) {
	    FOREACH_HASH(metadataTypePtr, value, clsPtr->metadataPtr) {
		metadataTypePtr->deleteProc(value);
	    }
	    Tcl_DeleteHashTable(clsPtr->metadataPtr);
	    ckfree(clsPtr->metadataPtr);
	    clsPtr->metadataPtr = NULL;
	}

	FOREACH(filterObj, clsPtr->filters) {
	    Tcl_DecrRefCount(filterObj);
	}
	if (i) {
	    ckfree(clsPtr->filters.list);
	    clsPtr->filters.num = 0;
	}
	FOREACH(mixinPtr, clsPtr->mixins) {
	    if (!Deleted(mixinPtr->thisPtr)) {
		TclOORemoveFromMixinSubs(clsPtr, mixinPtr);
	    }
	}
	if (i) {
	    ckfree(clsPtr->mixins.list);
	    clsPtr->mixins.num = 0;
	}
	FOREACH(superPtr, clsPtr->superclasses) {
	    if (!Deleted(superPtr->thisPtr)) {
		TclOORemoveFromSubclasses(clsPtr, superPtr);
	    }
	}
	if (i) {
	    ckfree(clsPtr->superclasses.list);
	    clsPtr->superclasses.num = 0;
	}
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
    }

    /*
     * Delete the object structure itself.
     */

    DelRef(oPtr);
    if (preserved) {
	if (clsPtr) {
	    DelRef(clsPtr);
	}
	DelRef(oPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromInstances --
 *







<
<
<
<
<
<







1235
1236
1237
1238
1239
1240
1241






1242
1243
1244
1245
1246
1247
1248
    }

    /*
     * Delete the object structure itself.
     */

    DelRef(oPtr);






}

/*
 * ----------------------------------------------------------------------
 *
 * TclOORemoveFromInstances --
 *
1112
1113
1114
1115
1116
1117
1118



1119
1120
1121
1122
1123
1124

1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144



1145
1146
1147
1148
1149
1150
1151
	if (oPtr == instPtr) {
	    goto removeInstance;
	}
    }
    return;

  removeInstance:



    clsPtr->instances.num--;
    if (i < clsPtr->instances.num) {
	clsPtr->instances.list[i] =
		clsPtr->instances.list[clsPtr->instances.num];
    }
    clsPtr->instances.list[clsPtr->instances.num] = NULL;

}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToInstances --
 *
 *	Utility function to add an object to the list of instances within a
 *	class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToInstances(
    Object *oPtr,		/* The instance to add. */
    Class *clsPtr)		/* The class to add the instance to. It is
				 * assumed that the class is not already
				 * present as an instance in the class. */
{



    if (clsPtr->instances.num >= clsPtr->instances.size) {
	clsPtr->instances.size += ALLOC_CHUNK;
	if (clsPtr->instances.size == ALLOC_CHUNK) {
	    clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);







>
>
>
|
|
|
|
|
|
>




















>
>
>







1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
	if (oPtr == instPtr) {
	    goto removeInstance;
	}
    }
    return;

  removeInstance:
    if (Deleted(clsPtr->thisPtr)) {
	clsPtr->instances.list[i] = NULL;
    } else {
	clsPtr->instances.num--;
	if (i < clsPtr->instances.num) {
	    clsPtr->instances.list[i] =
		    clsPtr->instances.list[clsPtr->instances.num];
	}
	clsPtr->instances.list[clsPtr->instances.num] = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToInstances --
 *
 *	Utility function to add an object to the list of instances within a
 *	class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToInstances(
    Object *oPtr,		/* The instance to add. */
    Class *clsPtr)		/* The class to add the instance to. It is
				 * assumed that the class is not already
				 * present as an instance in the class. */
{
    if (Deleted(clsPtr->thisPtr)) {
	return;
    }
    if (clsPtr->instances.num >= clsPtr->instances.size) {
	clsPtr->instances.size += ALLOC_CHUNK;
	if (clsPtr->instances.size == ALLOC_CHUNK) {
	    clsPtr->instances.list = ckalloc(sizeof(Object *) * ALLOC_CHUNK);
	} else {
	    clsPtr->instances.list = ckrealloc(clsPtr->instances.list,
		    sizeof(Object *) * clsPtr->instances.size);
1178
1179
1180
1181
1182
1183
1184



1185
1186
1187
1188
1189
1190

1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210



1211
1212
1213
1214
1215
1216
1217
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:



    superPtr->subclasses.num--;
    if (i < superPtr->subclasses.num) {
	superPtr->subclasses.list[i] =
		superPtr->subclasses.list[superPtr->subclasses.num];
    }
    superPtr->subclasses.list[superPtr->subclasses.num] = NULL;

}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToSubclasses --
 *
 *	Utility function to add a class to the list of subclasses within
 *	another class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToSubclasses(
    Class *subPtr,		/* The subclass to add. */
    Class *superPtr)		/* The superclass to add the subclass to. It
				 * is assumed that the class is not already
				 * present as a subclass in the superclass. */
{



    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);







>
>
>
|
|
|
|
|
|
>




















>
>
>







1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
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
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:
    if (Deleted(superPtr->thisPtr)) {
	superPtr->subclasses.list[i] = NULL;
    } else {
	superPtr->subclasses.num--;
	if (i < superPtr->subclasses.num) {
	    superPtr->subclasses.list[i] =
		    superPtr->subclasses.list[superPtr->subclasses.num];
	}
	superPtr->subclasses.list[superPtr->subclasses.num] = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToSubclasses --
 *
 *	Utility function to add a class to the list of subclasses within
 *	another class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToSubclasses(
    Class *subPtr,		/* The subclass to add. */
    Class *superPtr)		/* The superclass to add the subclass to. It
				 * is assumed that the class is not already
				 * present as a subclass in the superclass. */
{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->subclasses.num >= superPtr->subclasses.size) {
	superPtr->subclasses.size += ALLOC_CHUNK;
	if (superPtr->subclasses.size == ALLOC_CHUNK) {
	    superPtr->subclasses.list = ckalloc(sizeof(Class*) * ALLOC_CHUNK);
	} else {
	    superPtr->subclasses.list = ckrealloc(superPtr->subclasses.list,
		    sizeof(Class *) * superPtr->subclasses.size);
1244
1245
1246
1247
1248
1249
1250



1251
1252
1253
1254
1255
1256

1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276



1277
1278
1279
1280
1281
1282
1283
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:



    superPtr->mixinSubs.num--;
    if (i < superPtr->mixinSubs.num) {
	superPtr->mixinSubs.list[i] =
		superPtr->mixinSubs.list[superPtr->mixinSubs.num];
    }
    superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;

}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToMixinSubs --
 *
 *	Utility function to add a class to the list of mixinSubs within
 *	another class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToMixinSubs(
    Class *subPtr,		/* The subclass to add. */
    Class *superPtr)		/* The superclass to add the subclass to. It
				 * is assumed that the class is not already
				 * present as a subclass in the superclass. */
{



    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
	superPtr->mixinSubs.size += ALLOC_CHUNK;
	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
	    superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);







>
>
>
|
|
|
|
|
|
>




















>
>
>







1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
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
	if (subPtr == subclsPtr) {
	    goto removeSubclass;
	}
    }
    return;

  removeSubclass:
    if (Deleted(superPtr->thisPtr)) {
	superPtr->mixinSubs.list[i] = NULL;
    } else {
	superPtr->mixinSubs.num--;
	if (i < superPtr->mixinSubs.num) {
	    superPtr->mixinSubs.list[i] =
		    superPtr->mixinSubs.list[superPtr->mixinSubs.num];
	}
	superPtr->mixinSubs.list[superPtr->mixinSubs.num] = NULL;
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOAddToMixinSubs --
 *
 *	Utility function to add a class to the list of mixinSubs within
 *	another class.
 *
 * ----------------------------------------------------------------------
 */

void
TclOOAddToMixinSubs(
    Class *subPtr,		/* The subclass to add. */
    Class *superPtr)		/* The superclass to add the subclass to. It
				 * is assumed that the class is not already
				 * present as a subclass in the superclass. */
{
    if (Deleted(superPtr->thisPtr)) {
	return;
    }
    if (superPtr->mixinSubs.num >= superPtr->mixinSubs.size) {
	superPtr->mixinSubs.size += ALLOC_CHUNK;
	if (superPtr->mixinSubs.size == ALLOC_CHUNK) {
	    superPtr->mixinSubs.list = ckalloc(sizeof(Class *) * ALLOC_CHUNK);
	} else {
	    superPtr->mixinSubs.list = ckrealloc(superPtr->mixinSubs.list,
		    sizeof(Class *) * superPtr->mixinSubs.size);
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
     */

    if (objc >= 0) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);

	if (contextPtr != NULL) {
	    int result, flags;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;









	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
		    objc, objv);
	    flags = oPtr->flags;

	    /*
	     * It's an error if the object was whacked in the constructor.
	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...) [Bug 2903011]
	     */

	    if (result != TCL_ERROR && (flags & OBJECT_DELETED)) {
		Tcl_SetResult(interp, "object deleted in constructor",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
		result = TCL_ERROR;
	    }
	    TclOODeleteContext(contextPtr);
	    if (result != TCL_OK) {
		Tcl_DiscardInterpState(state);

		/*
		 * Take care to not delete a deleted object; that would be
		 * bad. [Bug 2903011]
		 */

		if (!(flags & OBJECT_DELETED)) {
		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
		}
		return NULL;
	    }
	    Tcl_RestoreInterpState(interp, state);
	}
    }







|





>
>
>
>
>
>
>
>
>


<







|














|







1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637

1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
     */

    if (objc >= 0) {
	CallContext *contextPtr =
		TclOOGetCallContext(oPtr, NULL, CONSTRUCTOR, NULL);

	if (contextPtr != NULL) {
	    int result;
	    Tcl_InterpState state;

	    state = Tcl_SaveInterpState(interp, TCL_OK);
	    contextPtr->callPtr->flags |= CONSTRUCTOR;
	    contextPtr->skip = skip;

	    /*
	     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
	     */

	    if (((Interp*) interp)->ensembleRewrite.sourceObjs) {
		((Interp*) interp)->ensembleRewrite.numInsertedObjs += skip-1;
		((Interp*) interp)->ensembleRewrite.numRemovedObjs += skip-1;
	    }
	    result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr,
		    objc, objv);


	    /*
	     * It's an error if the object was whacked in the constructor.
	     * Force this if it isn't already an error (don't want to lose
	     * errors by accident...) [Bug 2903011]
	     */

	    if (result != TCL_ERROR && Deleted(oPtr)) {
		Tcl_SetResult(interp, "object deleted in constructor",
			TCL_STATIC);
		Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
		result = TCL_ERROR;
	    }
	    TclOODeleteContext(contextPtr);
	    if (result != TCL_OK) {
		Tcl_DiscardInterpState(state);

		/*
		 * Take care to not delete a deleted object; that would be
		 * bad. [Bug 2903011]
		 */

		if (!Deleted(oPtr)) {
		    Tcl_DeleteCommandFromToken(interp, oPtr->command);
		}
		return NULL;
	    }
	    Tcl_RestoreInterpState(interp, state);
	}
    }
1563
1564
1565
1566
1567
1568
1569









1570
1571
1572
1573
1574

1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615

1616
1617
1618
1619

1620
1621
1622
1623
1624
1625
1626
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    contextPtr->callPtr->flags |= CONSTRUCTOR;
    contextPtr->skip = skip;










    /*
     * Fire off the constructors non-recursively.
     */


    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    Object *oPtr = data[1];
    Tcl_InterpState state = data[2];
    Tcl_Object *objectPtr = data[3];
    int flags = oPtr->flags;

    /*
     * It's an error if the object was whacked in the constructor. Force this
     * if it isn't already an error (don't want to lose errors by accident...)
     * [Bug 2903011]
     */

    if (result != TCL_ERROR && (flags & OBJECT_DELETED)) {
	Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
	result = TCL_ERROR;
    }
    TclOODeleteContext(contextPtr);
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*
	 * Take care to not delete a deleted object; that would be bad. [Bug
	 * 2903011]
	 */

	if (!(flags & OBJECT_DELETED)) {
	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
	}

	return TCL_ERROR;
    }
    Tcl_RestoreInterpState(interp, state);
    *objectPtr = (Tcl_Object) oPtr;

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_CopyObjectInstance --







>
>
>
>
>
>
>
>
>





>
















<







|













|


>




>







1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782

1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795
1796
1797
1798
1799
1800
1801
1802
1803
1804
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
	*objectPtr = (Tcl_Object) oPtr;
	return TCL_OK;
    }

    state = Tcl_SaveInterpState(interp, TCL_OK);
    contextPtr->callPtr->flags |= CONSTRUCTOR;
    contextPtr->skip = skip;

    /*
     * Adjust the ensmble tracking record if necessary. [Bug 3514761]
     */

    if (((Interp *) interp)->ensembleRewrite.sourceObjs) {
	((Interp *) interp)->ensembleRewrite.numInsertedObjs += skip - 1;
	((Interp *) interp)->ensembleRewrite.numRemovedObjs += skip - 1;
    }

    /*
     * Fire off the constructors non-recursively.
     */

    AddRef(oPtr);
    TclNRAddCallback(interp, FinalizeAlloc, contextPtr, oPtr, state,
	    objectPtr);
    TclPushTailcallPoint(interp);
    return TclOOInvokeContext(contextPtr, interp, objc, objv);
}

static int
FinalizeAlloc(
    ClientData data[],
    Tcl_Interp *interp,
    int result)
{
    CallContext *contextPtr = data[0];
    Object *oPtr = data[1];
    Tcl_InterpState state = data[2];
    Tcl_Object *objectPtr = data[3];


    /*
     * It's an error if the object was whacked in the constructor. Force this
     * if it isn't already an error (don't want to lose errors by accident...)
     * [Bug 2903011]
     */

    if (result != TCL_ERROR && Deleted(oPtr)) {
	Tcl_SetResult(interp, "object deleted in constructor", TCL_STATIC);
	Tcl_SetErrorCode(interp, "TCL", "OO", "STILLBORN", NULL);
	result = TCL_ERROR;
    }
    TclOODeleteContext(contextPtr);
    if (result != TCL_OK) {
	Tcl_DiscardInterpState(state);

	/*
	 * Take care to not delete a deleted object; that would be bad. [Bug
	 * 2903011]
	 */

	if (!Deleted(oPtr)) {
	    Tcl_DeleteCommandFromToken(interp, oPtr->command);
	}
	DelRef(oPtr);
	return TCL_ERROR;
    }
    Tcl_RestoreInterpState(interp, state);
    *objectPtr = (Tcl_Object) oPtr;
    DelRef(oPtr);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_CopyObjectInstance --
1639
1640
1641
1642
1643
1644
1645

1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
    const char *targetName,
    const char *targetNamespaceName)
{
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;

    Tcl_Obj *keyPtr, *filterObj, *variableObj;
    int i;

    /*
     * Sanity checks.
     */

    if (targetName == NULL && oPtr->classPtr != NULL) {
	Tcl_AppendResult(interp, "must supply a name when copying a class",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "NO_COPY_TARGET", NULL);
	return NULL;
    }
    if (oPtr->flags & ROOT_CLASS) {
	Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.







>
|
|


|


<
<
<
<
<
<
|







1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846






1847
1848
1849
1850
1851
1852
1853
1854
    const char *targetName,
    const char *targetNamespaceName)
{
    Object *oPtr = (Object *) sourceObject, *o2Ptr;
    FOREACH_HASH_DECLS;
    Method *mPtr;
    Class *mixinPtr;
    CallContext *contextPtr;
    Tcl_Obj *keyPtr, *filterObj, *variableObj, *args[3];
    int i, result;

    /*
     * Sanity check.
     */







    if (IsRootClass(oPtr)) {
	Tcl_AppendResult(interp, "may not clone the class of classes", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "CLONING_CLASS", NULL);
	return NULL;
    }

    /*
     * Build the instance. Note that this does not run any constructors.
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
     * Copy the object's flags to the new object, clearing those that must be
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

    o2Ptr->flags = oPtr->flags & ~(
	    OBJECT_DELETED | ROOT_OBJECT | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;







|







1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
     * Copy the object's flags to the new object, clearing those that must be
     * kept object-local. The duplicate is never deleted at this point, nor is
     * it the root of the object system or in the midst of processing a filter
     * call.
     */

    o2Ptr->flags = oPtr->flags & ~(
	    OBJECT_DELETED | ROOT_OBJECT | ROOT_CLASS | FILTER_HANDLING);

    /*
     * Copy the object's metadata.
     */

    if (oPtr->metadataPtr != NULL) {
	Tcl_ObjectMetadataType *metadataTypePtr;
1874
1875
1876
1877
1878
1879
1880

























1881
1882
1883
1884
1885
1886
1887
		if (duplicate != NULL) {
		    Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
			    duplicate);
		}
	    }
	}
    }


























    return (Tcl_Object) o2Ptr;
}

/*
 * ----------------------------------------------------------------------
 *







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







2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
		if (duplicate != NULL) {
		    Tcl_ClassSetMetadata((Tcl_Class) cls2Ptr, metadataTypePtr,
			    duplicate);
		}
	    }
	}
    }

    TclResetRewriteEnsemble(interp, 1);
    contextPtr = TclOOGetCallContext(o2Ptr, oPtr->fPtr->clonedName, 0, NULL);
    if (contextPtr) {
	args[0] = TclOOObjectName(interp, o2Ptr);
	args[1] = oPtr->fPtr->clonedName;
	args[2] = TclOOObjectName(interp, oPtr);
	Tcl_IncrRefCount(args[0]);
	Tcl_IncrRefCount(args[1]);
	Tcl_IncrRefCount(args[2]);
	result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 3,
		args);
	TclDecrRefCount(args[0]);
	TclDecrRefCount(args[1]);
	TclDecrRefCount(args[2]);
	TclOODeleteContext(contextPtr);
	if (result == TCL_ERROR) {
	    Tcl_AddErrorInfo(interp,
		    "\n    (while performing post-copy callback)");
	}
	if (result != TCL_OK) {
	    Tcl_DeleteCommandFromToken(interp, o2Ptr->command);
	    return NULL;
	}
    }

    return (Tcl_Object) o2Ptr;
}

/*
 * ----------------------------------------------------------------------
 *
2250
2251
2252
2253
2254
2255
2256





2257

2258
2259

2260
2261
2262
2263
2264
2265
2266
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    int result;






    if (objc < 2) {

	Tcl_WrongNumArgs(interp, 1, objv, "method ?arg ...?");
	return TCL_ERROR;

    }

    /*
     * Give plugged in code a chance to remap the method name.
     */

    methodNamePtr = objv[1];







>
>
>
>
>

>
|
<
>







2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477

2478
2479
2480
2481
2482
2483
2484
2485
				 * filters and the object's methods (which is
				 * the normal case). */
{
    CallContext *contextPtr;
    Tcl_Obj *methodNamePtr;
    int result;

    /*
     * If we've no method name, throw this directly into the unknown
     * processing.
     */

    if (objc < 2) {
	flags |= FORCE_UNKNOWN;
	methodNamePtr = NULL;

	goto noMapping;
    }

    /*
     * Give plugged in code a chance to remap the method name.
     */

    methodNamePtr = objv[1];
2706
2707
2708
2709
2710
2711
2712
2713
2714
2715
2716
2717
2718
2719
2720
    return (Tcl_Class) ((Object *)object)->classPtr;
}

int
Tcl_ObjectDeleted(
    Tcl_Object object)
{
    return (((Object *)object)->flags & OBJECT_DELETED) ? 1 : 0;
}

Tcl_Object
Tcl_GetClassAsObject(
    Tcl_Class clazz)
{
    return (Tcl_Object) ((Class *)clazz)->thisPtr;







|







2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
    return (Tcl_Class) ((Object *)object)->classPtr;
}

int
Tcl_ObjectDeleted(
    Tcl_Object object)
{
    return Deleted(object) ? 1 : 0;
}

Tcl_Object
Tcl_GetClassAsObject(
    Tcl_Class clazz)
{
    return (Tcl_Object) ((Class *)clazz)->thisPtr;

Changes to generic/tclOOBasic.c.

277
278
279
280
281
282
283

284
285
286
287
288
289
290
	oPtr->flags |= DESTRUCTOR_CALLED;
	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
		    NULL, NULL, NULL);

	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);
	}
    }
    if (oPtr->command) {
	Tcl_DeleteCommandFromToken(interp, oPtr->command);
    }
    return TCL_OK;







>







277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
	oPtr->flags |= DESTRUCTOR_CALLED;
	contextPtr = TclOOGetCallContext(oPtr, NULL, DESTRUCTOR, NULL);
	if (contextPtr != NULL) {
	    contextPtr->callPtr->flags |= DESTRUCTOR;
	    contextPtr->skip = 0;
	    TclNRAddCallback(interp, AfterNRDestructor, contextPtr,
		    NULL, NULL, NULL);
	    TclPushTailcallPoint(interp);
	    return TclOOInvokeContext(contextPtr, interp, 0, NULL);
	}
    }
    if (oPtr->command) {
	Tcl_DeleteCommandFromToken(interp, oPtr->command);
    }
    return TCL_OK;
430
431
432
433
434
435
436






437
438
439
440
441
442
443
444
445
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);







    if (objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "methodName ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Get the list of methods that we want to know about.
     */








>
>
>
>
>
>

|







431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
    Tcl_Obj *const *objv)	/* The actual arguments. */
{
    CallContext *contextPtr = (CallContext *) context;
    Object *oPtr = contextPtr->oPtr;
    const char **methodNames;
    int numMethodNames, i, skip = Tcl_ObjectContextSkippedArgs(context);

    /*
     * If no method name, generate an error asking for a method name. (Only by
     * overriding *this* method can an object handle the absence of a method
     * name without an error).
     */

    if (objc < skip+1) {
	Tcl_WrongNumArgs(interp, skip, objv, "method ?arg ...?");
	return TCL_ERROR;
    }

    /*
     * Get the list of methods that we want to know about.
     */

Changes to generic/tclOOCall.c.

33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
/*
 * Extra flags used for call chain management.
 */

#define DEFINITE_PROTECTED 0x100000
#define DEFINITE_PUBLIC    0x200000
#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR)

/*
 * Function declarations for things defined in this file.
 */

static void		AddClassFiltersToCallContext(Object *const oPtr,
			    Class *clsPtr, struct ChainBuilder *const cbPtr,







|







33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
/*
 * Extra flags used for call chain management.
 */

#define DEFINITE_PROTECTED 0x100000
#define DEFINITE_PUBLIC    0x200000
#define KNOWN_STATE	   (DEFINITE_PROTECTED | DEFINITE_PUBLIC)
#define SPECIAL		   (CONSTRUCTOR | DESTRUCTOR | FORCE_UNKNOWN)

/*
 * Function declarations for things defined in this file.
 */

static void		AddClassFiltersToCallContext(Object *const oPtr,
			    Class *clsPtr, struct ChainBuilder *const cbPtr,
991
992
993
994
995
996
997
















998
999
1000
1001
1002
1003
1004

    callPtr = ckalloc(sizeof(CallChain));
    InitCallChain(callPtr, oPtr, flags);

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = oPtr;

















    /*
     * Add all defined filters (if any, and if we're going to be processing
     * them; they're not processed for constructors, destructors or when we're
     * in the middle of processing a filter).
     */








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







991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020

    callPtr = ckalloc(sizeof(CallChain));
    InitCallChain(callPtr, oPtr, flags);

    cb.callChainPtr = callPtr;
    cb.filterLength = 0;
    cb.oPtr = oPtr;

    /*
     * If we're working with a forced use of unknown, do that now.
     */

    if (flags & FORCE_UNKNOWN) {
	AddSimpleChainToCallContext(oPtr, oPtr->fPtr->unknownMethodNameObj,
		&cb, NULL, 0, NULL);
	callPtr->flags |= OO_UNKNOWN_METHOD;
	callPtr->epoch = -1;
	if (callPtr->numChain == 0) {
	    TclOODeleteChain(callPtr);
	    return NULL;
	}
	goto returnContext;
    }

    /*
     * Add all defined filters (if any, and if we're going to be processing
     * them; they're not processed for constructors, destructors or when we're
     * in the middle of processing a filter).
     */

Changes to generic/tclOODefineCmds.c.

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

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"


















/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *className, const char *errMsg);
static inline int	InitDefineContext(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr, Object *oPtr,
			    int objc, Tcl_Obj *const objv[]);
static inline void	RecomputeClassCacheFlag(Object *oPtr);
static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
			    int useClass, Tcl_Obj *const fromPtr,
			    Tcl_Obj *const toPtr);


























































/*
 * ----------------------------------------------------------------------
 *
 * BumpGlobalEpoch --
 *	Utility that ensures that call chains that are invalid will get thrown
 *	away at an appropriate time. Note that exactly which epoch gets







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
















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







12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif
#include "tclInt.h"
#include "tclOOInt.h"

/*
 * Some things that make it easier to declare a slot.
 */

struct DeclaredSlot {
    const char *name;
    const Tcl_MethodType getterType;
    const Tcl_MethodType setterType;
};

#define SLOT(name,getter,setter)					\
    {"::oo::" name,							\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Getter", \
		    getter, NULL, NULL},				\
	    {TCL_OO_METHOD_VERSION_CURRENT, "core method: " name " Setter", \
		    setter, NULL, NULL}}

/*
 * Forward declarations.
 */

static inline void	BumpGlobalEpoch(Tcl_Interp *interp, Class *classPtr);
static Tcl_Command	FindCommand(Tcl_Interp *interp, Tcl_Obj *stringObj,
			    Tcl_Namespace *const namespacePtr);
static inline Class *	GetClassInOuterContext(Tcl_Interp *interp,
			    Tcl_Obj *className, const char *errMsg);
static inline int	InitDefineContext(Tcl_Interp *interp,
			    Tcl_Namespace *namespacePtr, Object *oPtr,
			    int objc, Tcl_Obj *const objv[]);
static inline void	RecomputeClassCacheFlag(Object *oPtr);
static int		RenameDeleteMethod(Tcl_Interp *interp, Object *oPtr,
			    int useClass, Tcl_Obj *const fromPtr,
			    Tcl_Obj *const toPtr);
static int		ClassFilterGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassFilterSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassMixinSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassSuperSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ClassVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjFilterSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjMixinSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsGet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);
static int		ObjVarsSet(ClientData clientData,
			    Tcl_Interp *interp, Tcl_ObjectContext context,
			    int objc, Tcl_Obj *const *objv);

/*
 * Now define the slots used in declarations.
 */

static const struct DeclaredSlot slots[] = {
    SLOT("define::filter",      ClassFilterGet, ClassFilterSet),
    SLOT("define::mixin",       ClassMixinGet,  ClassMixinSet),
    SLOT("define::superclass",  ClassSuperGet,  ClassSuperSet),
    SLOT("define::variable",    ClassVarsGet,   ClassVarsSet),
    SLOT("objdefine::filter",   ObjFilterGet,   ObjFilterSet),
    SLOT("objdefine::mixin",    ObjMixinGet,    ObjMixinSet),
    SLOT("objdefine::variable", ObjVarsGet,     ObjVarsSet),
    {NULL, {0, 0, 0, 0, 0}, {0, 0, 0, 0, 0}}
};

/*
 * ----------------------------------------------------------------------
 *
 * BumpGlobalEpoch --
 *	Utility that ensures that call chains that are invalid will get thrown
 *	away at an appropriate time. Note that exactly which epoch gets
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineFilterObjCmd --
 *	Implementation of the "filter" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineFilterObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceFilter = (clientData != NULL);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceFilter && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    if (!isInstanceFilter) {
	TclOOClassSetFilters(interp, oPtr->classPtr, objc-1, objv+1);
    } else {
	TclOOObjectSetFilters(oPtr, objc-1, objv+1);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineForwardObjCmd --
 *	Implementation of the "forward" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */








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







1458
1459
1460
1461
1462
1463
1464





































1465
1466
1467
1468
1469
1470
1471
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *





































 * TclOODefineForwardObjCmd --
 *	Implementation of the "forward" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineSuperclassObjCmd --
 *	Implementation of the "superclass" subcommand of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineSuperclassObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr;
    Class **superclasses, *superPtr;
    int i, j;

    if (objc < 2) {
	Tcl_WrongNumArgs(interp, 1, objv, "className ?className ...?");
	return TCL_ERROR;
    }

    /*
     * Get the class to operate on.
     */

    oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (oPtr->classPtr == NULL) {
	Tcl_AppendResult(interp, "only classes may have superclasses defined",
		NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "OBJECT_NOT_CLASS", NULL);
	return TCL_ERROR;
    }
    if (oPtr->flags & ROOT_OBJECT) {
	Tcl_AppendResult(interp,
		"may not modify the superclass of the root object", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    /*
     * Allocate some working space.
     */

    superclasses = ckalloc(sizeof(Class *) * (objc-1));

    /*
     * Parse the arguments to get the class to use as superclasses.
     */

    for (i=0 ; i<objc-1 ; i++) {
	Class *clsPtr = GetClassInOuterContext(interp, objv[i+1],
		"only a class can be a superclass");

	if (clsPtr == NULL) {
	    goto failedAfterAlloc;
	}
	for (j=0 ; j<i ; j++) {
	    if (superclasses[j] == clsPtr) {
		Tcl_AppendResult(interp,
			"class should only be a direct superclass once",NULL);
		Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
		goto failedAfterAlloc;
	    }
	}
	if (TclOOIsReachable(oPtr->classPtr, clsPtr)) {
	    Tcl_AppendResult(interp,
		    "attempt to form circular dependency graph", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	failedAfterAlloc:
	    ckfree(superclasses);
	    return TCL_ERROR;
	}
	superclasses[i] = clsPtr;
    }

    /*
     * Install the list of superclasses into the class. Note that this also
     * involves splicing the class out of the superclasses' subclass list that
     * it used to be a member of and splicing it into the new superclasses'
     * subclass list.
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	}
	ckfree(oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = objc-1;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineUnexportObjCmd --
 *	Implementation of the "unexport" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */








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







1689
1690
1691
1692
1693
1694
1695










































































































1696
1697
1698
1699
1700
1701
1702
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *










































































































 * TclOODefineUnexportObjCmd --
 *	Implementation of the "unexport" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineVariablesObjCmd --
 *	Implementation of the "variable" subcommand of the "oo::define" and
 *	"oo::objdefine" commands.
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineVariablesObjCmd(
    ClientData clientData,
    Tcl_Interp *interp,
    int objc,
    Tcl_Obj *const *objv)
{
    int isInstanceVars = (clientData != NULL);
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *variableObj;
    int i;

    if (oPtr == NULL) {
	return TCL_ERROR;
    }
    if (!isInstanceVars && !oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    for (i=1 ; i<objc ; i++) {
	const char *varName = Tcl_GetString(objv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not contain namespace separators",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not refer to an array element", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }
    for (i=1 ; i<objc ; i++) {
	Tcl_IncrRefCount(objv[i]);
    }

    if (!isInstanceVars) {
	FOREACH(variableObj, oPtr->classPtr->variables) {
	    Tcl_DecrRefCount(variableObj);
	}
	if (i != objc-1) {
	    if (objc == 1) {
		ckfree(oPtr->classPtr->variables.list);
	    } else if (i) {
		oPtr->classPtr->variables.list =
			ckrealloc(oPtr->classPtr->variables.list,
			sizeof(Tcl_Obj *) * (objc-1));
	    } else {
		oPtr->classPtr->variables.list =
			ckalloc(sizeof(Tcl_Obj *) * (objc-1));
	    }
	}
	if (objc > 1) {
	    memcpy(oPtr->classPtr->variables.list, objv+1,
		    sizeof(Tcl_Obj *) * (objc-1));
	}
	oPtr->classPtr->variables.num = objc-1;
    } else {
	FOREACH(variableObj, oPtr->variables) {
	    Tcl_DecrRefCount(variableObj);
	}
	if (i != objc-1) {
	    if (objc == 1) {
		ckfree(oPtr->variables.list);
	    } else if (i) {
		oPtr->variables.list = ckrealloc(oPtr->variables.list,
			sizeof(Tcl_Obj *) * (objc-1));
	    } else {
		oPtr->variables.list =
			ckalloc(sizeof(Tcl_Obj *) * (objc-1));
	    }
	}
	if (objc > 1) {
	    memcpy(oPtr->variables.list, objv+1, sizeof(Tcl_Obj *)*(objc-1));
	}
	oPtr->variables.num = objc-1;
    }
    return TCL_OK;
}

void
Tcl_ClassSetConstructor(
    Tcl_Interp *interp,
    Tcl_Class clazz,
    Tcl_Method method)
{
    Class *clsPtr = (Class *) clazz;







|
|
|




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







1782
1783
1784
1785
1786
1787
1788
1789
1790
1791
1792
1793
1794
1795






















































































1796
1797
1798
1799
1800
1801
1802
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * Tcl_ClassSetConstructor, Tcl_ClassSetDestructor --
 *	How to install a constructor or destructor into a class; API to call
 *	from C.
 *
 * ----------------------------------------------------------------------
 */























































































void
Tcl_ClassSetConstructor(
    Tcl_Interp *interp,
    Tcl_Class clazz,
    Tcl_Method method)
{
    Class *clsPtr = (Class *) clazz;
1987
1988
1989
1990
1991
1992
1993







































































































































































































































































































































































































































































































































































































































































































































































































1994
1995
1996
1997
1998
1999
2000
2001
	if (clsPtr->destructorChainPtr) {
	    TclOODeleteChain(clsPtr->destructorChainPtr);
	    clsPtr->destructorChainPtr = NULL;
	}
	BumpGlobalEpoch(interp, clsPtr);
    }
}








































































































































































































































































































































































































































































































































































































































































































































































































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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








1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
1977
1978
1979
1980
1981
1982
1983
1984
1985
1986
1987
1988
1989
1990
1991
1992
1993
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
2188
2189
2190
2191
2192
2193
2194
2195
2196
2197
2198
2199
2200
2201
2202
2203
2204
2205
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
2221
2222
2223
2224
2225
2226
2227
2228
2229
2230
2231
2232
2233
2234
2235
2236
2237
2238
2239
2240
2241
2242
2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
2277
2278
2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320
2321
2322
2323
2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
2340
2341
2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
2359
2360
2361
2362
2363
2364
2365
2366
2367
2368
2369
2370
2371
2372
2373
2374
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
2400
2401
2402
2403
2404
2405
2406
2407
2408
2409
2410
2411
2412
2413
2414
2415
2416
2417
2418
2419
2420
2421
2422
2423
2424
2425
2426
2427
2428
2429
2430
2431
2432
2433
2434
2435
2436
2437
2438
2439
2440
2441
2442
2443
2444
2445
2446
2447
2448
2449
2450
2451
2452
2453
2454
2455
2456
2457
2458
2459
2460
2461
2462
2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
2486
2487
2488
2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
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
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
	if (clsPtr->destructorChainPtr) {
	    TclOODeleteChain(clsPtr->destructorChainPtr);
	    clsPtr->destructorChainPtr = NULL;
	}
	BumpGlobalEpoch(interp, clsPtr);
    }
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOODefineSlots --
 *	Create the "::oo::Slot" class and its standard instances. Class
 *	definition is empty at the stage (added by scripting).
 *
 * ----------------------------------------------------------------------
 */

int
TclOODefineSlots(
    Foundation *fPtr)
{
    const struct DeclaredSlot *slotInfoPtr;
    Tcl_Obj *getName = Tcl_NewStringObj("Get", -1);
    Tcl_Obj *setName = Tcl_NewStringObj("Set", -1);
    Class *slotCls;

    slotCls = ((Object *) Tcl_NewObjectInstance(fPtr->interp, (Tcl_Class)
	    fPtr->classCls, "::oo::Slot", NULL, -1, NULL, 0))->classPtr;
    if (slotCls == NULL) {
	return TCL_ERROR;
    }
    Tcl_IncrRefCount(getName);
    Tcl_IncrRefCount(setName);
    for (slotInfoPtr = slots ; slotInfoPtr->name ; slotInfoPtr++) {
	Tcl_Object slotObject = Tcl_NewObjectInstance(fPtr->interp,
		(Tcl_Class) slotCls, slotInfoPtr->name, NULL,-1,NULL,0);

	if (slotObject == NULL) {
	    continue;
	}
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, getName, 0,
		&slotInfoPtr->getterType, NULL);
	Tcl_NewInstanceMethod(fPtr->interp, slotObject, setName, 0,
		&slotInfoPtr->setterType, NULL);
    }
    Tcl_DecrRefCount(getName);
    Tcl_DecrRefCount(setName);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassFilterGet, ClassFilterSet --
 *	Implementation of the "filter" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassFilterGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(filterObj, oPtr->classPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassFilterSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
	    &filterv) != TCL_OK) {
	return TCL_ERROR;
    }

    TclOOClassSetFilters(interp, oPtr->classPtr, filterc, filterv);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassMixinGet, ClassMixinSet --
 *	Implementation of the "mixin" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassMixinGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(mixinPtr, oPtr->classPtr->mixins) {
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, mixinPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;

}

static int
ClassMixinSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc, i;
    Tcl_Obj **mixinv;
    Class **mixins;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i=0 ; i<mixinc ; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    goto freeAndError;
	}
	if (TclOOIsReachable(oPtr->classPtr, mixins[i])) {
	    Tcl_AppendResult(interp, "may not mix a class into itself", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "SELF_MIXIN", NULL);
	    goto freeAndError;
	}
    }

    TclOOClassSetMixins(interp, oPtr->classPtr, mixinc, mixins);
    TclStackFree(interp, mixins);
    return TCL_OK;

  freeAndError:
    TclStackFree(interp, mixins);
    return TCL_ERROR;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassSuperGet, ClassSuperSet --
 *	Implementation of the "superclass" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassSuperGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *superPtr;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, superPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassSuperSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int superc, i, j;
    Tcl_Obj **superv;
    Class **superclasses, *superPtr;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"superclassList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (oPtr == oPtr->fPtr->objectCls->thisPtr) {
	Tcl_AppendResult(interp,
		"may not modify the superclass of the root object", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &superc,
	    &superv) != TCL_OK) {
	return TCL_ERROR;
    }

    /*
     * Allocate some working space.
     */

    superclasses = (Class **) ckalloc(sizeof(Class *) * superc);

    /*
     * Parse the arguments to get the class to use as superclasses.
     */

    for (i=0 ; i<superc ; i++) {
	superclasses[i] = GetClassInOuterContext(interp, superv[i],
		"only a class can be a superclass");
	if (superclasses[i] == NULL) {
	    goto failedAfterAlloc;
	}
	for (j=0 ; j<i ; j++) {
	    if (superclasses[j] == superclasses[i]) {
		Tcl_AppendResult(interp,
			"class should only be a direct superclass once",NULL);
		Tcl_SetErrorCode(interp, "TCL", "OO", "REPETITIOUS", NULL);
		goto failedAfterAlloc;
	    }
	}
	if (TclOOIsReachable(oPtr->classPtr, superclasses[i])) {
	    Tcl_AppendResult(interp,
		    "attempt to form circular dependency graph", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "CIRCULARITY", NULL);
	failedAfterAlloc:
	    ckfree((char *) superclasses);
	    return TCL_ERROR;
	}
    }

    /*
     * Install the list of superclasses into the class. Note that this also
     * involves splicing the class out of the superclasses' subclass list that
     * it used to be a member of and splicing it into the new superclasses'
     * subclass list.
     */

    if (oPtr->classPtr->superclasses.num != 0) {
	FOREACH(superPtr, oPtr->classPtr->superclasses) {
	    TclOORemoveFromSubclasses(oPtr->classPtr, superPtr);
	}
	ckfree((char *) oPtr->classPtr->superclasses.list);
    }
    oPtr->classPtr->superclasses.list = superclasses;
    oPtr->classPtr->superclasses.num = superc;
    FOREACH(superPtr, oPtr->classPtr->superclasses) {
	TclOOAddToSubclasses(oPtr->classPtr, superPtr);
    }
    BumpGlobalEpoch(interp, oPtr->classPtr);

    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ClassVarsGet, ClassVarsSet --
 *	Implementation of the "variable" slot accessors of the "oo::define"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ClassVarsGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *variableObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    }
    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ClassVarsSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc;
    Tcl_Obj **varv, *variableObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);

    if (oPtr == NULL) {
	return TCL_ERROR;
    } else if (!oPtr->classPtr) {
	Tcl_AppendResult(interp, "attempt to misuse API", NULL);
	Tcl_SetErrorCode(interp, "TCL", "OO", "MONKEY_BUSINESS", NULL);
	return TCL_ERROR;
    } else if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = Tcl_GetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not contain namespace separators",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not refer to an array element", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }

    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }
    FOREACH(variableObj, oPtr->classPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree((char *) oPtr->classPtr->variables.list);
	} else if (i) {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->classPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->classPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }

    oPtr->classPtr->variables.num = 0;
    if (varc > 0) {
	int created, n;
	Tcl_HashTable uniqueTable;

	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		oPtr->classPtr->variables.list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	oPtr->classPtr->variables.num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	oPtr->classPtr->variables.list = (Tcl_Obj **)
		ckrealloc((char *) oPtr->classPtr->variables.list,
		sizeof(Tcl_Obj *) * n);
	Tcl_DeleteHashTable(&uniqueTable);
    }
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectFilterGet, ObjectFilterSet --
 *	Implementation of the "filter" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjFilterGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *filterObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(filterObj, oPtr->filters) {
	Tcl_ListObjAppendElement(NULL, resultObj, filterObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjFilterSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int filterc;
    Tcl_Obj **filterv;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"filterList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &filterc,
	    &filterv) != TCL_OK) {
	return TCL_ERROR;
    }

    TclOOObjectSetFilters(oPtr, filterc, filterv);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectMixinGet, ObjectMixinSet --
 *	Implementation of the "mixin" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjMixinGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj;
    Class *mixinPtr;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(mixinPtr, oPtr->mixins) {
	Tcl_ListObjAppendElement(NULL, resultObj,
		TclOOObjectName(interp, mixinPtr->thisPtr));
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjMixinSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int mixinc;
    Tcl_Obj **mixinv;
    Class **mixins;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"mixinList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &mixinc,
	    &mixinv) != TCL_OK) {
	return TCL_ERROR;
    }

    mixins = TclStackAlloc(interp, sizeof(Class *) * mixinc);

    for (i=0 ; i<mixinc ; i++) {
	mixins[i] = GetClassInOuterContext(interp, mixinv[i],
		"may only mix in classes");
	if (mixins[i] == NULL) {
	    TclStackFree(interp, mixins);
	    return TCL_ERROR;
	}
    }

    TclOOObjectSetMixins(oPtr, mixinc, mixins);
    TclStackFree(interp, mixins);
    return TCL_OK;
}

/*
 * ----------------------------------------------------------------------
 *
 * ObjectVarsGet, ObjectVarsSet --
 *	Implementation of the "variable" slot accessors of the "oo::objdefine"
 *	command.
 *
 * ----------------------------------------------------------------------
 */

static int
ObjVarsGet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    Tcl_Obj *resultObj, *variableObj;
    int i;

    if (Tcl_ObjectContextSkippedArgs(context) != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		NULL);
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }

    resultObj = Tcl_NewObj();
    FOREACH(variableObj, oPtr->variables) {
	Tcl_ListObjAppendElement(NULL, resultObj, variableObj);
    }
    Tcl_SetObjResult(interp, resultObj);
    return TCL_OK;
}

static int
ObjVarsSet(
    ClientData clientData,
    Tcl_Interp *interp,
    Tcl_ObjectContext context,
    int objc,
    Tcl_Obj *const *objv)
{
    Object *oPtr = (Object *) TclOOGetDefineCmdContext(interp);
    int varc, i;
    Tcl_Obj **varv, *variableObj;

    if (Tcl_ObjectContextSkippedArgs(context)+1 != objc) {
	Tcl_WrongNumArgs(interp, Tcl_ObjectContextSkippedArgs(context), objv,
		"variableList");
	return TCL_ERROR;
    } else if (oPtr == NULL) {
	return TCL_ERROR;
    }
    objv += Tcl_ObjectContextSkippedArgs(context);
    if (Tcl_ListObjGetElements(interp, objv[0], &varc,
	    &varv) != TCL_OK) {
	return TCL_ERROR;
    }

    for (i=0 ; i<varc ; i++) {
	const char *varName = Tcl_GetString(varv[i]);

	if (strstr(varName, "::") != NULL) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not contain namespace separators",
		    NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
	if (Tcl_StringMatch(varName, "*(*)")) {
	    Tcl_AppendResult(interp, "invalid declared variable name \"",
		    varName, "\": must not refer to an array element", NULL);
	    Tcl_SetErrorCode(interp, "TCL", "OO", "BAD_DECLVAR", NULL);
	    return TCL_ERROR;
	}
    }
    for (i=0 ; i<varc ; i++) {
	Tcl_IncrRefCount(varv[i]);
    }

    FOREACH(variableObj, oPtr->variables) {
	Tcl_DecrRefCount(variableObj);
    }
    if (i != varc) {
	if (varc == 0) {
	    ckfree((char *) oPtr->variables.list);
	} else if (i) {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckrealloc((char *) oPtr->variables.list,
		    sizeof(Tcl_Obj *) * varc);
	} else {
	    oPtr->variables.list = (Tcl_Obj **)
		    ckalloc(sizeof(Tcl_Obj *) * varc);
	}
    }
    oPtr->variables.num = 0;
    if (varc > 0) {
	int created, n;
	Tcl_HashTable uniqueTable;

	Tcl_InitObjHashTable(&uniqueTable);
	for (i=n=0 ; i<varc ; i++) {
	    Tcl_CreateHashEntry(&uniqueTable, varv[i], &created);
	    if (created) {
		oPtr->variables.list[n++] = varv[i];
	    } else {
		Tcl_DecrRefCount(varv[i]);
	    }
	}
	oPtr->variables.num = n;

	/*
	 * Shouldn't be necessary, but maintain num/list invariant.
	 */

	oPtr->variables.list = (Tcl_Obj **)
		ckrealloc((char *) oPtr->variables.list,
		sizeof(Tcl_Obj *) * n);
	Tcl_DeleteHashTable(&uniqueTable);
    }
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to generic/tclOOInt.h.

210
211
212
213
214
215
216


217
218
219
220
221
222
223
				 * instance of the class, and has had nothing
				 * added that changes the dispatch chain (i.e.
				 * no methods, mixins, or filters. */
#define ROOT_CLASS 0x8000	/* Flag to say that this object is the root
				 * class of classes, and should be treated
				 * specially during teardown (and in a few
				 * other spots). */



/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {







>
>







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
				 * instance of the class, and has had nothing
				 * added that changes the dispatch chain (i.e.
				 * no methods, mixins, or filters. */
#define ROOT_CLASS 0x8000	/* Flag to say that this object is the root
				 * class of classes, and should be treated
				 * specially during teardown (and in a few
				 * other spots). */
#define FORCE_UNKNOWN 0x10000	/* States that we are *really* looking up the
				 * unknown method handler at that point. */

/*
 * And the definition of a class. Note that every class also has an associated
 * object, through which it is manipulated.
 */

typedef struct Class {
314
315
316
317
318
319
320


321
322
323
324
325
326
327
    Tcl_Obj *unknownMethodNameObj;
				/* Shared object containing the name of the
				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
				 * constructor. */
    Tcl_Obj *destructorName;	/* Shared object containing the "name" of a
				 * destructor. */


} Foundation;

/*
 * A call context structure is built when a method is called. They contain the
 * chain of method implementations that are to be invoked by a particular
 * call, and the process of calling walks the chain, with the [next] command
 * proceeding to the next entry in the chain.







>
>







316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
    Tcl_Obj *unknownMethodNameObj;
				/* Shared object containing the name of the
				 * unknown method handler method. */
    Tcl_Obj *constructorName;	/* Shared object containing the "name" of a
				 * constructor. */
    Tcl_Obj *destructorName;	/* Shared object containing the "name" of a
				 * destructor. */
    Tcl_Obj *clonedName;	/* Shared object containing the name of a
				 * "<cloned>" pseudo-constructor. */
} Foundation;

/*
 * A call context structure is built when a method is called. They contain the
 * chain of method implementations that are to be invoked by a particular
 * call, and the process of calling walks the chain, with the [next] command
 * proceeding to the next entry in the chain.
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
				 * only) method. */
#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
#define CONSTRUCTOR	  0x08	/* This is a constructor. */
#define DESTRUCTOR	  0x10	/* This is a destructor. */

/*
 * Assorted flags for call frames. Note that bits 1 and 2 are already taken by
 * Tcl itself.
 */

#if 0
#define FRAME_IS_METHOD	0x4	/* The frame is a method body, and the frame's
				 * clientData field contains a CallContext
				 * reference. */
#define FRAME_IS_OO_DEFINE 0x8	/* The frame is part of the inside workings of
				 * the [oo::define] command; the clientData
				 * field contains an Object reference that has
				 * been confirmed to refer to a class. */
#endif

/*
 * Structure containing definition information about basic class methods.
 */

typedef struct {
    const char *name;		/* Name of the method in question. */
    int isPublic;		/* Whether the method is public by default. */







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







376
377
378
379
380
381
382















383
384
385
386
387
388
389
#define PUBLIC_METHOD     0x01	/* This is a public (exported) method. */
#define PRIVATE_METHOD    0x02	/* This is a private (class's direct instances
				 * only) method. */
#define OO_UNKNOWN_METHOD 0x04	/* This is an unknown method. */
#define CONSTRUCTOR	  0x08	/* This is a constructor. */
#define DESTRUCTOR	  0x10	/* This is a destructor. */
















/*
 * Structure containing definition information about basic class methods.
 */

typedef struct {
    const char *name;		/* Name of the method in question. */
    int isPublic;		/* Whether the method is public by default. */
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineExportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineFilterObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineForwardObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMixinObjCmd(ClientData clientData,
			    Tcl_Interp *interp, const int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSuperclassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineUnexportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineVariablesObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,







<
<
<






<
<
<



<
<
<



<
<
<







411
412
413
414
415
416
417



418
419
420
421
422
423



424
425
426



427
428
429



430
431
432
433
434
435
436
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineDestructorObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineExportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



MODULE_SCOPE int	TclOODefineForwardObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



MODULE_SCOPE int	TclOODefineRenameMethodObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



MODULE_SCOPE int	TclOODefineUnexportObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);



MODULE_SCOPE int	TclOODefineClassObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOODefineSelfObjCmd(ClientData clientData,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const *objv);
MODULE_SCOPE int	TclOOUnknownDefinition(ClientData clientData,
510
511
512
513
514
515
516

517
518
519
520
521
522
523
MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, int objc,
			    Tcl_Obj *const *objv, int skip,
			    Tcl_Object *objectPtr);

MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Tcl_Obj *cacheInThisObj);







>







487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
MODULE_SCOPE void	TclOOAddToMixinSubs(Class *subPtr, Class *mixinPtr);
MODULE_SCOPE void	TclOOAddToSubclasses(Class *subPtr, Class *superPtr);
MODULE_SCOPE int	TclNRNewObjectInstance(Tcl_Interp *interp,
			    Tcl_Class cls, const char *nameStr,
			    const char *nsNameStr, int objc,
			    Tcl_Obj *const *objv, int skip,
			    Tcl_Object *objectPtr);
MODULE_SCOPE int	TclOODefineSlots(Foundation *fPtr);
MODULE_SCOPE void	TclOODeleteChain(CallChain *callPtr);
MODULE_SCOPE void	TclOODeleteChainCache(Tcl_HashTable *tablePtr);
MODULE_SCOPE void	TclOODeleteContext(CallContext *contextPtr);
MODULE_SCOPE void	TclOODelMethodRef(Method *method);
MODULE_SCOPE CallContext *TclOOGetCallContext(Object *oPtr,
			    Tcl_Obj *methodNameObj, int flags,
			    Tcl_Obj *cacheInThisObj);

Changes to generic/tclPanic.c.

10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25



26

27
28
29
30
31
32
33
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#ifdef _WIN32
    MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
#endif

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




static Tcl_PanicProc *panicProc = NULL;


/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.







|








>
>
>

>







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
 * Copyright (c) 1998-1999 by Scriptics Corporation.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#if defined(_WIN32) || defined(__CYGWIN__)
    MODULE_SCOPE void tclWinDebugPanic(const char *format, ...);
#endif

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

#if defined(__CYGWIN__)
static Tcl_PanicProc *panicProc = tclWinDebugPanic;
#else
static Tcl_PanicProc *panicProc = NULL;
#endif

/*
 *----------------------------------------------------------------------
 *
 * Tcl_SetPanicProc --
 *
 *	Replace the default panic behavior with the specified function.
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
 *----------------------------------------------------------------------
 */

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







|







45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
 *----------------------------------------------------------------------
 */

void
Tcl_SetPanicProc(
    Tcl_PanicProc *proc)
{
#if defined(_WIN32)
    /* tclWinDebugPanic only installs if there is no panicProc yet. */
    if ((proc != tclWinDebugPanic) || (panicProc == NULL))
#endif
    panicProc = proc;
}

/*
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112


113
114
115
116
117
118
119
    } else {
	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
		arg8);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
    /* In case the users panic proc does not abort, we do it here */
#ifdef _WIN32
#   if defined(__GNUC__)
    __builtin_trap();
#   elif defined(_WIN64)
    __debugbreak();
#   elif defined(_MSC_VER)
    _asm {int 3}
#   else
    DebugBreak();
#   endif


    ExitProcess(1);
#else
    abort();
#endif
}

/*







|









>
>







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
    } else {
	fprintf(stderr, format, arg1, arg2, arg3, arg4, arg5, arg6, arg7,
		arg8);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
    /* In case the users panic proc does not abort, we do it here */
#if defined(_WIN32) || defined(__CYGWIN__)
#   if defined(__GNUC__)
    __builtin_trap();
#   elif defined(_WIN64)
    __debugbreak();
#   elif defined(_MSC_VER)
    _asm {int 3}
#   else
    DebugBreak();
#   endif
#endif
#if defined(_WIN32)
    ExitProcess(1);
#else
    abort();
#endif
}

/*

Changes to generic/tclParse.c.

10
11
12
13
14
15
16

17
18
19
20
21
22
23
 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
 
#include "tclInt.h"


/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with either signed or
 * unsigned characters, so it has 384 entries. The first 128 entries
 * correspond to negative character values, the next 256 correspond to
 * positive character values. The last 128 entries are identical to the first







>







10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 * Contributions from Don Porter, NIST, 2002. (not subject to US copyright)
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */
 
#include "tclInt.h"
#include "tclParse.h"

/*
 * The following table provides parsing information about each possible 8-bit
 * character. The table is designed to be referenced with either signed or
 * unsigned characters, so it has 384 entries. The first 128 entries
 * correspond to negative character values, the next 256 correspond to
 * positive character values. The last 128 entries are identical to the first
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
 *			open bracket.
 * TYPE_QUOTE -		Character is a double quote.
 * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -	Character is a right square bracket.
 * TYPE_BRACE -		Character is a curly brace (either left or right).
 */

#define TYPE_NORMAL		0
#define TYPE_SPACE		0x1
#define TYPE_COMMAND_END	0x2
#define TYPE_SUBS		0x4
#define TYPE_QUOTE		0x8
#define TYPE_CLOSE_PAREN	0x10
#define TYPE_CLOSE_BRACK	0x20
#define TYPE_BRACE		0x40

#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]

static const char charTypeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,







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







38
39
40
41
42
43
44











45
46
47
48
49
50
51
52
 *			open bracket.
 * TYPE_QUOTE -		Character is a double quote.
 * TYPE_CLOSE_PAREN -	Character is a right parenthesis.
 * TYPE_CLOSE_BRACK -	Character is a right square bracket.
 * TYPE_BRACE -		Character is a curly brace (either left or right).
 */












const char charTypeTable[] = {
    /*
     * Negative character values, from -128 to -1:
     */

    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,
    TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,      TYPE_NORMAL,

Added generic/tclParse.h.



































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
/*
 * Minimal set of shared macro definitions and declarations so that multiple
 * source files can make use of the parsing table in tclParse.c
 */

#define TYPE_NORMAL		0
#define TYPE_SPACE		0x1
#define TYPE_COMMAND_END	0x2
#define TYPE_SUBS		0x4
#define TYPE_QUOTE		0x8
#define TYPE_CLOSE_PAREN	0x10
#define TYPE_CLOSE_BRACK	0x20
#define TYPE_BRACE		0x40

#define CHAR_TYPE(c) (charTypeTable+128)[(int)(c)]

MODULE_SCOPE const char charTypeTable[];

Changes to generic/tclPathObj.c.

2342
2343
2344
2345
2346
2347
2348
2349
2350
2351
2352
2353
2354
2355
2356
2357
2358
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;
#if defined(__CYGWIN__) && defined(__WIN32__)
    int copied = 0;
#endif
     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*







<
<
<







2342
2343
2344
2345
2346
2347
2348



2349
2350
2351
2352
2353
2354
2355
    Tcl_Interp *interp,		/* Used for error reporting if not NULL. */
    Tcl_Obj *pathPtr)		/* The object to convert. */
{
    int len;
    FsPath *fsPathPtr;
    Tcl_Obj *transPtr;
    char *name;



     ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&tclFsDataKey);

    if (pathPtr->typePtr == &tclFsPathType) {
	return TCL_OK;
    }

    /*
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = TclJoinPath(1, &pathPtr);
    }

#if defined(__CYGWIN__) && defined(__WIN32__)
    {
	char winbuf[MAX_PATH+1];

	/*
	 * In the Cygwin world, call conv_to_win32_path in order to use the
	 * mount table to translate the file name into something Windows will
	 * understand. Take care when converting empty strings!
	 */

	name = Tcl_GetStringFromObj(transPtr, &len);
	if (len > 0) {
	    cygwin_conv_to_win32_path(name, winbuf);
	    TclWinNoBackslash(winbuf);
	    if (Tcl_IsShared(transPtr)) {
		copied = 1;
		transPtr = Tcl_DuplicateObj(transPtr);
		Tcl_IncrRefCount(transPtr);
	    }
	    Tcl_SetStringObj(transPtr, winbuf, -1);
	}
    }
#endif /* __CYGWIN__ && __WIN32__ */

    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = ckalloc(sizeof(FsPath));








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







2489
2490
2491
2492
2493
2494
2495
























2496
2497
2498
2499
2500
2501
2502
	    }
	}
	Tcl_DStringFree(&temp);
    } else {
	transPtr = TclJoinPath(1, &pathPtr);
    }

























    /*
     * Now we have a translated filename in 'transPtr'. This will have forward
     * slashes on Windows, and will not contain any ~user sequences.
     */

    fsPathPtr = ckalloc(sizeof(FsPath));

2541
2542
2543
2544
2545
2546
2547
2548
2549
2550
2551
2552
2553
2554
2555
2556
2557
2558
2559
2560
     * Free old representation before installing our new one.
     */

    TclFreeIntRep(pathPtr);
    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;
#if defined(__CYGWIN__) && defined(__WIN32__)
    if (copied) {
	Tcl_DecrRefCount(transPtr);
    }
#endif

    return TCL_OK;
}

static void
FreeFsPathInternalRep(
    Tcl_Obj *pathPtr)		/* Path object with internal rep to free. */
{







<
<
<
<
<
<







2514
2515
2516
2517
2518
2519
2520






2521
2522
2523
2524
2525
2526
2527
     * Free old representation before installing our new one.
     */

    TclFreeIntRep(pathPtr);
    SETPATHOBJ(pathPtr, fsPathPtr);
    PATHFLAGS(pathPtr) = 0;
    pathPtr->typePtr = &tclFsPathType;






    return TCL_OK;
}

static void
FreeFsPathInternalRep(
    Tcl_Obj *pathPtr)		/* Path object with internal rep to free. */
{

Changes to generic/tclPkgConfig.c.

18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 *
 * - TCL_THREADS		OSCMa compilation as threaded core.
 * - TCL_MEM_DEBUG		OSCMa memory debugging.
 * - TCL_COMPILE_DEBUG		OSCMa debugging of bytecode compiler.
 * - TCL_COMPILE_STATS		OSCMa bytecode compiler statistics.
 *
 * - TCL_CFG_DO64BIT		NSCMdt tcl is compiled for a 64bit system.
 * - TCL_CFG_DEBUG		NSCMdt tcl is compiled with symbol info on.
 * - TCL_CFG_OPTIMIZED		NSCMdt tcl is compiled with cc optimizations on
 * - TCL_CFG_PROFILED		NSCMdt tcl is compiled with profiling info.
 *
 * - CFG_RUNTIME_*		Paths to various stuff at runtime.
 * - CFG_INSTALL_*		Paths to various stuff at installation time.
 *
 * - TCL_CFGVAL_ENCODING	string containing the encoding used for the







|







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
 *
 * - TCL_THREADS		OSCMa compilation as threaded core.
 * - TCL_MEM_DEBUG		OSCMa memory debugging.
 * - TCL_COMPILE_DEBUG		OSCMa debugging of bytecode compiler.
 * - TCL_COMPILE_STATS		OSCMa bytecode compiler statistics.
 *
 * - TCL_CFG_DO64BIT		NSCMdt tcl is compiled for a 64bit system.
 * - NDEBUG		NSCMdt tcl is compiled with symbol info off.
 * - TCL_CFG_OPTIMIZED		NSCMdt tcl is compiled with cc optimizations on
 * - TCL_CFG_PROFILED		NSCMdt tcl is compiled with profiling info.
 *
 * - CFG_RUNTIME_*		Paths to various stuff at runtime.
 * - CFG_INSTALL_*		Paths to various stuff at installation time.
 *
 * - TCL_CFGVAL_ENCODING	string containing the encoding used for the
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

#ifdef TCL_CFG_DO64BIT
#  define CFG_64		"1"
#else
#  define CFG_64		"0"
#endif

#ifdef TCL_CFG_DEBUG
#  define CFG_DEBUG		"1"
#else
#  define CFG_DEBUG		"0"
#endif

#ifdef TCL_CFG_OPTIMIZED
#  define CFG_OPTIMIZED		"1"







|







66
67
68
69
70
71
72
73
74
75
76
77
78
79
80

#ifdef TCL_CFG_DO64BIT
#  define CFG_64		"1"
#else
#  define CFG_64		"0"
#endif

#ifndef NDEBUG
#  define CFG_DEBUG		"1"
#else
#  define CFG_DEBUG		"0"
#endif

#ifdef TCL_CFG_OPTIMIZED
#  define CFG_OPTIMIZED		"1"

Changes to generic/tclPlatDecls.h.

42
43
44
45
46
47
48












49
50
51
52
53
54
55

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */













#ifdef __WIN32__ /* WIN */
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);







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







42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67

/* !BEGIN!: Do not edit below this line. */

/*
 * Exported function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
/* 0 */
EXTERN int		Tcl_MacOSXOpenBundleResources(Tcl_Interp *interp,
				const char *bundleName, int hasResourceFile,
				int maxPathLen, char *libraryPath);
/* 1 */
EXTERN int		Tcl_MacOSXOpenVersionedBundleResources(
				Tcl_Interp *interp, const char *bundleName,
				const char *bundleVersion,
				int hasResourceFile, int maxPathLen,
				char *libraryPath);
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
/* 0 */
EXTERN TCHAR *		Tcl_WinUtfToTChar(const char *str, int len,
				Tcl_DString *dsPtr);
/* 1 */
EXTERN char *		Tcl_WinTCharToUtf(const TCHAR *str, int len,
				Tcl_DString *dsPtr);
67
68
69
70
71
72
73




74
75
76
77
78
79
80
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    const struct TclPlatStubHooks *hooks;





#ifdef __WIN32__ /* WIN */
    TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
    char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */







>
>
>
>







79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
				char *libraryPath);
#endif /* MACOSX */

typedef struct TclPlatStubs {
    int magic;
    const struct TclPlatStubHooks *hooks;

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    TCHAR * (*tcl_WinUtfToTChar) (const char *str, int len, Tcl_DString *dsPtr); /* 0 */
    char * (*tcl_WinTCharToUtf) (const TCHAR *str, int len, Tcl_DString *dsPtr); /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    int (*tcl_MacOSXOpenBundleResources) (Tcl_Interp *interp, const char *bundleName, int hasResourceFile, int maxPathLen, char *libraryPath); /* 0 */
    int (*tcl_MacOSXOpenVersionedBundleResources) (Tcl_Interp *interp, const char *bundleName, const char *bundleVersion, int hasResourceFile, int maxPathLen, char *libraryPath); /* 1 */
91
92
93
94
95
96
97






98
99
100
101
102
103
104

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */







#ifdef __WIN32__ /* WIN */
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */







>
>
>
>
>
>







107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

#if defined(USE_TCL_STUBS)

/*
 * Inline function declarations:
 */

#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
#define Tcl_MacOSXOpenBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenBundleResources) /* 0 */
#define Tcl_MacOSXOpenVersionedBundleResources \
	(tclPlatStubsPtr->tcl_MacOSXOpenVersionedBundleResources) /* 1 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
#define Tcl_WinUtfToTChar \
	(tclPlatStubsPtr->tcl_WinUtfToTChar) /* 0 */
#define Tcl_WinTCharToUtf \
	(tclPlatStubsPtr->tcl_WinTCharToUtf) /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */

Changes to generic/tclPort.h.

25
26
27
28
29
30
31


32
33
34
35


36
37
38
39
40
41
42
#   include "tclUnixPort.h"
#endif

#if defined(__CYGWIN__)
#   define USE_PUTENV 1
#   define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */


    DLLIMPORT extern char **__cygwin_environ;
    DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
#   define environ __cygwin_environ
#   define timezone _timezone


#endif

#if !defined(LLONG_MIN)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT







>
>


|
<
>
>







25
26
27
28
29
30
31
32
33
34
35
36

37
38
39
40
41
42
43
44
45
#   include "tclUnixPort.h"
#endif

#if defined(__CYGWIN__)
#   define USE_PUTENV 1
#   define USE_PUTENV_FOR_UNSET 1
/* On Cygwin, the environment is imported from the Cygwin DLL. */
#   define environ __cygwin_environ
#   define timezone _timezone
    DLLIMPORT extern char **__cygwin_environ;
    DLLIMPORT extern int cygwin_conv_to_win32_path(const char *, char *);
    DLLIMPORT extern int cygwin_posix_to_win32_path_list_buf_size(char *value);

    DLLIMPORT extern void cygwin_posix_to_win32_path_list(char *buf, char *value);
    DLLIMPORT extern void __stdcall SetEnvironmentVariableA(const char*, const char *);
#endif

#if !defined(LLONG_MIN)
#   ifdef TCL_WIDE_INT_IS_LONG
#      define LLONG_MIN LONG_MIN
#   else
#      ifdef LLONG_BIT

Changes to generic/tclStringObj.c.

1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    memcpy(stringPtr->unicode + stringPtr->numChars, unicode,
	    appendNumChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->allocated = 0;

    TclInvalidateStringRep(objPtr);
}







|







1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
    }

    /*
     * Copy the new string onto the end of the old string, then add the
     * trailing null.
     */

    memmove(stringPtr->unicode + stringPtr->numChars, unicode,
	    appendNumChars * sizeof(Tcl_UniChar));
    stringPtr->unicode[numChars] = 0;
    stringPtr->numChars = numChars;
    stringPtr->allocated = 0;

    TclInvalidateStringRep(objPtr);
}
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    memcpy(objPtr->bytes + oldLength, bytes, numBytes);
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}

/*
 *----------------------------------------------------------------------
 *







|







1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
    /*
     * Invalidate the unicode data.
     */

    stringPtr->numChars = -1;
    stringPtr->hasUnicode = 0;

    memmove(objPtr->bytes + oldLength, bytes, numBytes);
    objPtr->bytes[newLength] = 0;
    objPtr->length = newLength;
}

/*
 *----------------------------------------------------------------------
 *

Changes to generic/tclStubInit.c.

35
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














































































































































#define TclpLocaltime_unix TclpLocaltime
#define TclpGmtime_unix TclpGmtime


/*
 * WARNING: The contents of this file is automatically generated by the
 * tools/genStubs.tcl script. Any modifications to the function declarations
 * below should be made in the generic/tcl.decls script.
 */








>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
|
>







35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
#undef Tcl_NewStringObj
#undef Tcl_DumpActiveMemory
#undef Tcl_ValidateAllMemory
#undef Tcl_FindHashEntry
#undef Tcl_CreateHashEntry
#undef Tcl_Panic
#undef Tcl_FindExecutable
#undef TclSockMinimumBuffers

/* See bug 510001: TclSockMinimumBuffers needs plat imp */
#ifdef _WIN64
#   define TclSockMinimumBuffersOld 0
#else
#define TclSockMinimumBuffersOld sockMinimumBuffersOld
static int TclSockMinimumBuffersOld(sock, size)
    int sock;
    int size;
{
    return TclSockMinimumBuffers(INT2PTR(sock), size);
}
#endif

#ifdef __CYGWIN__

/* Trick, so we don't have to include <windows.h> here, which
 * - b.t.w. - lacks this function anyway */
#define GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS 0x00000004
int __stdcall GetModuleHandleExW(unsigned int, const char *, void *);

#define TclWinGetPlatformId winGetPlatformId
#define Tcl_WinUtfToTChar winUtfToTChar
#define Tcl_WinTCharToUtf winTCharToUtf
#define TclWinGetTclInstance winGetTclInstance
#define TclWinNToHS winNToHS
#define TclWinSetSockOpt winSetSockOpt
#define TclWinNoBackslash winNoBackslash
#define TclWinSetInterfaces (void (*) (int)) doNothing
#define TclWinAddProcess (void (*) (void *, unsigned int)) doNothing
#define TclWinFlushDirtyChannels doNothing
#define TclWinResetInterfaces doNothing

static Tcl_Encoding winTCharEncoding;

static int
TclWinGetPlatformId()
{
    /* Don't bother to determine the real platform on cygwin,
     * because VER_PLATFORM_WIN32_NT is the only supported platform */
    return 2; /* VER_PLATFORM_WIN32_NT */;
}

static void *TclWinGetTclInstance()
{
    void *hInstance = NULL;
    GetModuleHandleExW(GET_MODULE_HANDLE_EX_FLAG_FROM_ADDRESS,
	    (const char *)&winTCharEncoding, &hInstance);
    return hInstance;
}

static unsigned short
TclWinNToHS(unsigned short ns)
{
    return ntohs(ns);
}

static int
TclWinSetSockOpt(void *s, int level, int optname,
	    const char *optval, int optlen)
{
    return setsockopt((int) s, level, optname, optval, optlen);
}

static char *
TclWinNoBackslash(char *path)
{
    char *p;

    for (p = path; *p != '\0'; p++) {
	if (*p == '\\') {
	    *p = '/';
	}
    }
    return path;
}

static void
doNothing(void)
{
    /* dummy implementation, no need to do anything */
}

static char *
Tcl_WinUtfToTChar(string, len, dsPtr)
    const char *string;
    int len;
    Tcl_DString *dsPtr;
{
    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return Tcl_UtfToExternalDString(winTCharEncoding,
	    string, len, dsPtr);
}

static char *
Tcl_WinTCharToUtf(
    const char *string,
    int len,
    Tcl_DString *dsPtr)
{
    if (!winTCharEncoding) {
	winTCharEncoding = Tcl_GetEncoding(0, "unicode");
    }
    return Tcl_ExternalToUtfDString(winTCharEncoding,
	    string, len, dsPtr);
}

#define Tcl_MacOSXOpenBundleResources (int (*) _ANSI_ARGS_(( \
		Tcl_Interp *, const char *, int, int, char *))) Tcl_WinUtfToTChar
#define Tcl_MacOSXOpenVersionedBundleResources (int (*) _ANSI_ARGS_(( \
		Tcl_Interp *, const char *, const char *, int, int, char *))) Tcl_WinTCharToUtf
#define TclMacOSXGetFileAttribute (int (*) _ANSI_ARGS_((Tcl_Interp *,  \
		int, Tcl_Obj *, Tcl_Obj **))) TclpCreateProcess
#define TclMacOSXMatchType (int (*) _ANSI_ARGS_((Tcl_Interp *, const char *, \
		const char *, Tcl_StatBuf *, Tcl_GlobTypeData *))) TclpMakeFile
#define TclMacOSXNotifierAddRunLoopMode (void (*) _ANSI_ARGS_((const void *))) TclpOpenFile
#define TclpLocaltime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclGetAndDetachPids
#define TclpGmtime_unix (struct tm *(*) _ANSI_ARGS_((const time_t *))) TclpCloseFile

#elif !defined(__WIN32__) /* UNIX and MAC */
#   define TclWinConvertError (void (*) _ANSI_ARGS_((unsigned int))) TclGetAndDetachPids
#   undef TclWinConvertWSAError
#   define TclWinConvertWSAError (void (*) _ANSI_ARGS_((unsigned int))) TclpCloseFile
#   define TclWinGetPlatformId (int (*)()) TclpCreateTempFile
#   define TclWinGetTclInstance (void *(*)()) TclpCreateProcess
#   define TclWinNToHS (unsigned short (*) _ANSI_ARGS_((unsigned short ns))) TclpMakeFile
#   define TclWinSetSockOpt (int (*) _ANSI_ARGS_((void *, int, int, const char *, int))) TclpOpenFile
#   define TclWinAddProcess 0
#   define TclWinNoBackslash 0
#   define TclWinSetInterfaces 0
#   define TclWinFlushDirtyChannels 0
#   define TclWinResetInterfaces 0
#   define TclMacOSXGetFileAttribute 0 /* Only implemented in Tcl >= 8.5 */
#   define TclMacOSXMatchType 0 /* Only implemented in Tcl >= 8.5 */
#   define TclMacOSXNotifierAddRunLoopMode 0 /* Only implemented in Tcl >= 8.5 */
#   ifndef MAC_OSX_TCL
#	define Tcl_MacOSXOpenBundleResources 0
#	define Tcl_MacOSXOpenVersionedBundleResources 0
#   endif
#   define TclpLocaltime_unix TclpLocaltime
#   define TclpGmtime_unix TclpGmtime
#endif

/*
 * WARNING: The contents of this file is automatically generated by the
 * tools/genStubs.tcl script. Any modifications to the function declarations
 * below should be made in the generic/tcl.decls script.
 */

130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    TclpGetTime, /* 77 */
    TclpGetTimeZone, /* 78 */
    0, /* 79 */
    0, /* 80 */
    TclpRealloc, /* 81 */
    0, /* 82 */
    0, /* 83 */
    0, /* 84 */
    0, /* 85 */







|







273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
    0, /* 71 */
    0, /* 72 */
    0, /* 73 */
    TclpFree, /* 74 */
    TclpGetClicks, /* 75 */
    TclpGetSeconds, /* 76 */
    TclpGetTime, /* 77 */
    0, /* 78 */
    0, /* 79 */
    0, /* 80 */
    TclpRealloc, /* 81 */
    0, /* 82 */
    0, /* 83 */
    0, /* 84 */
    0, /* 85 */
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    0, /* 99 */
    0, /* 100 */
    TclSetPreInitScript, /* 101 */
    TclSetupEnv, /* 102 */
    TclSockGetPort, /* 103 */
    TclSockMinimumBuffers, /* 104 */
    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    0, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    Tcl_AppendExportList, /* 112 */
    Tcl_CreateNamespace, /* 113 */
    Tcl_DeleteNamespace, /* 114 */
    Tcl_Export, /* 115 */
    Tcl_FindCommand, /* 116 */
    Tcl_FindNamespace, /* 117 */







|





|







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
    TclResetShadowedCmdRefs, /* 97 */
    TclServiceIdle, /* 98 */
    0, /* 99 */
    0, /* 100 */
    TclSetPreInitScript, /* 101 */
    TclSetupEnv, /* 102 */
    TclSockGetPort, /* 103 */
    TclSockMinimumBuffersOld, /* 104 */
    0, /* 105 */
    0, /* 106 */
    0, /* 107 */
    TclTeardownNamespace, /* 108 */
    TclUpdateReturnInfo, /* 109 */
    TclSockMinimumBuffers, /* 110 */
    Tcl_AddInterpResolvers, /* 111 */
    Tcl_AppendExportList, /* 112 */
    Tcl_CreateNamespace, /* 113 */
    Tcl_DeleteNamespace, /* 114 */
    Tcl_Export, /* 115 */
    Tcl_FindCommand, /* 116 */
    Tcl_FindNamespace, /* 117 */
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330

















331
332
333
334
335
336
337
    TclSetSlaveCancelFlags, /* 250 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    0, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */

















#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    TclWinConvertError, /* 0 */
    TclWinConvertWSAError, /* 1 */
    TclWinGetServByName, /* 2 */
    TclWinGetSockOpt, /* 3 */
    TclWinGetTclInstance, /* 4 */







|
|


|

|
|

|





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







452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
    TclSetSlaveCancelFlags, /* 250 */
};

static const TclIntPlatStubs tclIntPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    TclWinConvertError, /* 0 */
    TclWinConvertWSAError, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclWinGetTclInstance, /* 4 */
    0, /* 5 */
    TclWinNToHS, /* 6 */
    TclWinSetSockOpt, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclWinGetPlatformId, /* 9 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    0, /* 16 */
    0, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
    TclGetAndDetachPids, /* 30 */
    TclpCloseFile, /* 31 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    TclWinConvertError, /* 0 */
    TclWinConvertWSAError, /* 1 */
    TclWinGetServByName, /* 2 */
    TclWinGetSockOpt, /* 3 */
    TclWinGetTclInstance, /* 4 */
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384












385
386
387
388
389
390




391
392
393
394
395
396
397
    0, /* 16 */
    0, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    TclpGetTZName, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    TclGetAndDetachPids, /* 0 */
    TclpCloseFile, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclpCreateProcess, /* 4 */
    0, /* 5 */
    TclpMakeFile, /* 6 */
    TclpOpenFile, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclpCreateTempFile, /* 9 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */












#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    0,




#ifdef __WIN32__ /* WIN */
    Tcl_WinUtfToTChar, /* 0 */
    Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */







|








|
|


|

|
|

|










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






>
>
>
>







509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
    0, /* 16 */
    0, /* 17 */
    TclpMakeFile, /* 18 */
    TclpOpenFile, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    TclWinConvertError, /* 0 */
    TclWinConvertWSAError, /* 1 */
    TclpCreateCommandChannel, /* 2 */
    TclpCreatePipe, /* 3 */
    TclWinGetTclInstance, /* 4 */
    0, /* 5 */
    TclWinNToHS, /* 6 */
    TclWinSetSockOpt, /* 7 */
    TclUnixWaitForFile, /* 8 */
    TclWinGetPlatformId, /* 9 */
    TclpReaddir, /* 10 */
    TclpLocaltime_unix, /* 11 */
    TclpGmtime_unix, /* 12 */
    TclpInetNtoa, /* 13 */
    TclUnixCopyFile, /* 14 */
    TclMacOSXGetFileAttribute, /* 15 */
    TclMacOSXSetFileAttribute, /* 16 */
    TclMacOSXCopyFileAttributes, /* 17 */
    TclMacOSXMatchType, /* 18 */
    TclMacOSXNotifierAddRunLoopMode, /* 19 */
    TclWinAddProcess, /* 20 */
    0, /* 21 */
    TclpCreateTempFile, /* 22 */
    0, /* 23 */
    TclWinNoBackslash, /* 24 */
    0, /* 25 */
    TclWinSetInterfaces, /* 26 */
    TclWinFlushDirtyChannels, /* 27 */
    TclWinResetInterfaces, /* 28 */
    TclWinCPUID, /* 29 */
    TclGetAndDetachPids, /* 30 */
    TclpCloseFile, /* 31 */
#endif /* MACOSX */
};

static const TclPlatStubs tclPlatStubs = {
    TCL_STUB_MAGIC,
    0,
#if !defined(__WIN32__) && !defined(MAC_OSX_TCL) /* UNIX */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */
#endif /* UNIX */
#ifdef __WIN32__ /* WIN */
    Tcl_WinUtfToTChar, /* 0 */
    Tcl_WinTCharToUtf, /* 1 */
#endif /* WIN */
#ifdef MAC_OSX_TCL /* MACOSX */
    Tcl_MacOSXOpenBundleResources, /* 0 */
    Tcl_MacOSXOpenVersionedBundleResources, /* 1 */

Changes to generic/tclThreadAlloc.c.

808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
 */

static void
LockBucket(
    Cache *cachePtr,
    int bucket)
{
#if 0
    if (Tcl_MutexTryLock(bucketInfo[bucket].lockPtr) != TCL_OK) {
	Tcl_MutexLock(bucketInfo[bucket].lockPtr);
	cachePtr->buckets[bucket].numWaits++;
	sharedPtr->buckets[bucket].numWaits++;
    }
#else
    Tcl_MutexLock(bucketInfo[bucket].lockPtr);
#endif
    cachePtr->buckets[bucket].numLocks++;
    sharedPtr->buckets[bucket].numLocks++;
}

static void
UnlockBucket(
    Cache *cachePtr,







<
<
|
<
<
<
<
<
<







808
809
810
811
812
813
814


815






816
817
818
819
820
821
822
 */

static void
LockBucket(
    Cache *cachePtr,
    int bucket)
{


    Tcl_MutexLock(bucketInfo[bucket].lockPtr);






    cachePtr->buckets[bucket].numLocks++;
    sharedPtr->buckets[bucket].numLocks++;
}

static void
UnlockBucket(
    Cache *cachePtr,

Changes to generic/tclTomMath.decls.

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
declare 59 {
    int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
}
declare 60 {
    int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
}
declare 61 {
    int TclBN_mp_init_set_int(mp_int* a, unsigned long i)
}
declare 62 {
    int TclBN_mp_set_int(mp_int* a, unsigned long i)
}
declare 63 {
    int TclBN_mp_cnt_lsb(const mp_int* a)
}







|


|


|

209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
declare 59 {
    int TclBN_s_mp_sqr(mp_int *a, mp_int *b)
}
declare 60 {
    int TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c)
}
declare 61 {
    int TclBN_mp_init_set_int(mp_int *a, unsigned long i)
}
declare 62 {
    int TclBN_mp_set_int(mp_int *a, unsigned long i)
}
declare 63 {
    int TclBN_mp_cnt_lsb(const mp_int *a)
}

Changes to generic/tclTomMathDecls.h.

266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
EXTERN int		TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
				int digs);
/* 59 */
EXTERN int		TclBN_s_mp_sqr(mp_int *a, mp_int *b);
/* 60 */
EXTERN int		TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
/* 61 */
EXTERN int		TclBN_mp_init_set_int(mp_int*a, unsigned long i);
/* 62 */
EXTERN int		TclBN_mp_set_int(mp_int*a, unsigned long i);
/* 63 */
EXTERN int		TclBN_mp_cnt_lsb(const mp_int*a);

typedef struct TclTomMathStubs {
    int magic;
    const struct TclTomMathStubHooks *hooks;

    int (*tclBN_epoch) (void); /* 0 */
    int (*tclBN_revision) (void); /* 1 */







|

|

|







266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
EXTERN int		TclBN_s_mp_mul_digs(mp_int *a, mp_int *b, mp_int *c,
				int digs);
/* 59 */
EXTERN int		TclBN_s_mp_sqr(mp_int *a, mp_int *b);
/* 60 */
EXTERN int		TclBN_s_mp_sub(mp_int *a, mp_int *b, mp_int *c);
/* 61 */
EXTERN int		TclBN_mp_init_set_int(mp_int *a, unsigned long i);
/* 62 */
EXTERN int		TclBN_mp_set_int(mp_int *a, unsigned long i);
/* 63 */
EXTERN int		TclBN_mp_cnt_lsb(const mp_int *a);

typedef struct TclTomMathStubs {
    int magic;
    const struct TclTomMathStubHooks *hooks;

    int (*tclBN_epoch) (void); /* 0 */
    int (*tclBN_revision) (void); /* 1 */
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    int (*tclBN_mp_karatsuba_sqr) (mp_int *a, mp_int *b); /* 54 */
    int (*tclBN_mp_toom_mul) (mp_int *a, mp_int *b, mp_int *c); /* 55 */
    int (*tclBN_mp_toom_sqr) (mp_int *a, mp_int *b); /* 56 */
    int (*tclBN_s_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 57 */
    int (*tclBN_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 58 */
    int (*tclBN_s_mp_sqr) (mp_int *a, mp_int *b); /* 59 */
    int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
    int (*tclBN_mp_init_set_int) (mp_int*a, unsigned long i); /* 61 */
    int (*tclBN_mp_set_int) (mp_int*a, unsigned long i); /* 62 */
    int (*tclBN_mp_cnt_lsb) (const mp_int*a); /* 63 */
} TclTomMathStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclTomMathStubs *tclTomMathStubsPtr;
#ifdef __cplusplus







|
|
|







337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
    int (*tclBN_mp_karatsuba_sqr) (mp_int *a, mp_int *b); /* 54 */
    int (*tclBN_mp_toom_mul) (mp_int *a, mp_int *b, mp_int *c); /* 55 */
    int (*tclBN_mp_toom_sqr) (mp_int *a, mp_int *b); /* 56 */
    int (*tclBN_s_mp_add) (mp_int *a, mp_int *b, mp_int *c); /* 57 */
    int (*tclBN_s_mp_mul_digs) (mp_int *a, mp_int *b, mp_int *c, int digs); /* 58 */
    int (*tclBN_s_mp_sqr) (mp_int *a, mp_int *b); /* 59 */
    int (*tclBN_s_mp_sub) (mp_int *a, mp_int *b, mp_int *c); /* 60 */
    int (*tclBN_mp_init_set_int) (mp_int *a, unsigned long i); /* 61 */
    int (*tclBN_mp_set_int) (mp_int *a, unsigned long i); /* 62 */
    int (*tclBN_mp_cnt_lsb) (const mp_int *a); /* 63 */
} TclTomMathStubs;

#ifdef __cplusplus
extern "C" {
#endif
extern const TclTomMathStubs *tclTomMathStubsPtr;
#ifdef __cplusplus

Changes to generic/tclTrace.c.

1120
1121
1122
1123
1124
1125
1126








1127
1128


1129
1130
1131
1132
1133
1134
1135
    tracePtr->clientData = clientData;
    tracePtr->flags = flags &
	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
    tracePtr->nextPtr = cmdPtr->tracePtr;
    tracePtr->refCount = 1;
    cmdPtr->tracePtr = tracePtr;
    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {








	cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
    }


    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceCommand --







>
>
>
>
>
>
>
>


>
>







1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
    tracePtr->clientData = clientData;
    tracePtr->flags = flags &
	    (TCL_TRACE_RENAME | TCL_TRACE_DELETE | TCL_TRACE_ANY_EXEC);
    tracePtr->nextPtr = cmdPtr->tracePtr;
    tracePtr->refCount = 1;
    cmdPtr->tracePtr = tracePtr;
    if (tracePtr->flags & TCL_TRACE_ANY_EXEC) {
	/*
	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
	 */
	
	if ((cmdPtr->compileProc != NULL) && !(cmdPtr->flags & CMD_HAS_EXEC_TRACES)){
	    Interp *iPtr = (Interp *) interp;
	    iPtr->compileEpoch++;
	}
	cmdPtr->flags |= CMD_HAS_EXEC_TRACES;
    }

    
    return TCL_OK;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_UntraceCommand --
1224
1225
1226
1227
1228
1229
1230









1231
1232
1233
1234
1235
1236
1237

	/*
	 * None of the remaining traces on this command are execution traces.
	 * We therefore remove this flag:
	 */

	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;









    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceCommandProc --







>
>
>
>
>
>
>
>
>







1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256

	/*
	 * None of the remaining traces on this command are execution traces.
	 * We therefore remove this flag:
	 */

	cmdPtr->flags &= ~CMD_HAS_EXEC_TRACES;

        /*
	 * Bug 3484621: up the interp's epoch if this is a BC'ed command
	 */
	
	if (cmdPtr->compileProc != NULL) {
	    Interp *iPtr = (Interp *) interp;
	    iPtr->compileEpoch++;
	}
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TraceCommandProc --

Changes to generic/tclUtil.c.

9
10
11
12
13
14
15

16
17
18
19
20
21
22
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */








>







9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
 * Copyright (c) 2001 by Kevin B. Kenny. All rights reserved.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclParse.h"
#include <math.h>

/*
 * The absolute pathname of the executable in which this Tcl library is
 * running.
 */

968
969
970
971
972
973
974

975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
	forbidNone = 1;
#if COMPAT
	preferBrace = 1;
#endif
    }

    while (length) {

	switch (*p) {
	case '{':
#if COMPAT
	    braceCount++;
#endif
	    extra++;				/* Escape '{' => '\{' */
	    nestingLevel++;
	    break;
	case '}':
#if COMPAT
	    braceCount++;
#endif
	    extra++;				/* Escape '}' => '\}' */
	    nestingLevel--;
	    if (nestingLevel < 0) {
		/* Unbalanced braces!  Cannot format with brace quoting. */
		requireEscape = 1;
	    }
	    break;
	case ']':
	case '"':
#if COMPAT
	    forbidNone = 1;
	    extra++;		/* Escapes all just prepend a backslash */
	    preferEscape = 1;
	    break;
#else
	    /* FLOW THROUGH */
#endif
	case '[':
	case '$':
	case ';':
	case ' ':
	case '\f':
	case '\n':
	case '\r':
	case '\t':
	case '\v':
	    forbidNone = 1;
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif
	    break;
	case '\\':
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
		/* Final backslash. Cannot format with brace quoting. */
		requireEscape = 1;		
		break;
	    }
	    if (p[1] == '\n') {







>

|






|










|
|








|
|
|
|
|
|
|
|
|






|







969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
	forbidNone = 1;
#if COMPAT
	preferBrace = 1;
#endif
    }

    while (length) {
      if (CHAR_TYPE(*p) != TYPE_NORMAL) {
	switch (*p) {
	case '{':	/* TYPE_BRACE */
#if COMPAT
	    braceCount++;
#endif
	    extra++;				/* Escape '{' => '\{' */
	    nestingLevel++;
	    break;
	case '}':	/* TYPE_BRACE */
#if COMPAT
	    braceCount++;
#endif
	    extra++;				/* Escape '}' => '\}' */
	    nestingLevel--;
	    if (nestingLevel < 0) {
		/* Unbalanced braces!  Cannot format with brace quoting. */
		requireEscape = 1;
	    }
	    break;
	case ']':	/* TYPE_CLOSE_BRACK */
	case '"':	/* TYPE_SPACE */
#if COMPAT
	    forbidNone = 1;
	    extra++;		/* Escapes all just prepend a backslash */
	    preferEscape = 1;
	    break;
#else
	    /* FLOW THROUGH */
#endif
	case '[':	/* TYPE_SUBS */
	case '$':	/* TYPE_SUBS */
	case ';':	/* TYPE_COMMAND_END */
	case ' ':	/* TYPE_SPACE */
	case '\f':	/* TYPE_SPACE */
	case '\n':	/* TYPE_COMMAND_END */
	case '\r':	/* TYPE_SPACE */
	case '\t':	/* TYPE_SPACE */
	case '\v':	/* TYPE_SPACE */
	    forbidNone = 1;
	    extra++;		/* Escape sequences all one byte longer. */
#if COMPAT
	    preferBrace = 1;
#endif
	    break;
	case '\\':	/* TYPE_SUBS */
	    extra++;				/* Escape '\' => '\\' */
	    if ((length == 1) || ((length == -1) && (p[1] == '\0'))) {
		/* Final backslash. Cannot format with brace quoting. */
		requireEscape = 1;		
		break;
	    }
	    if (p[1] == '\n') {
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050

1051
1052
1053
1054
1055
1056
1057
		p++;
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif
	    break;
	case '\0':
	    if (length == -1) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	}

	length -= (length > 0);
	p++;
    }

    endOfString:
    if (nestingLevel != 0) {
	/* Unbalanced braces!  Cannot format with brace quoting. */







|






>







1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
		p++;
	    }
	    forbidNone = 1;
#if COMPAT
	    preferBrace = 1;
#endif
	    break;
	case '\0':	/* TYPE_SUBS */
	    if (length == -1) {
		goto endOfString;
	    }
	    /* TODO: Panic on improper encoding? */
	    break;
	}
      }
	length -= (length > 0);
	p++;
    }

    endOfString:
    if (nestingLevel != 0) {
	/* Unbalanced braces!  Cannot format with brace quoting. */
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

    if (exactPtr) {
	*exactPtr = (anchorLeft && anchorRight);
    }

#if 0
    fprintf(stderr, "INPUT RE '%.*s' OUTPUT GLOB '%s' anchor %d:%d \n",
	    reStrLen, reStr,
	    Tcl_DStringValue(dsPtr), anchorLeft, anchorRight);
    fflush(stderr);
#endif
    return TCL_OK;

  invalidGlob:
#if 0
    fprintf(stderr, "INPUT RE '%.*s' NO OUTPUT GLOB %s (%c)\n",
	    reStrLen, reStr, msg, *p);
    fflush(stderr);
#endif
    if (interp != NULL) {
	Tcl_AppendResult(interp, msg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}







<
<
<
<
<
<



<
<
<
<
<







4117
4118
4119
4120
4121
4122
4123






4124
4125
4126





4127
4128
4129
4130
4131
4132
4133
    }
    Tcl_DStringSetLength(dsPtr, dsStr - dsStrStart);

    if (exactPtr) {
	*exactPtr = (anchorLeft && anchorRight);
    }







    return TCL_OK;

  invalidGlob:





    if (interp != NULL) {
	Tcl_AppendResult(interp, msg, NULL);
	Tcl_SetErrorCode(interp, "TCL", "RE2GLOB", code, NULL);
    }
    Tcl_DStringFree(dsPtr);
    return TCL_ERROR;
}

Changes to generic/tclVar.c.

14
15
16
17
18
19
20

21
22
23
24
25
26
27
 * Copyright (c) 2007 Miguel Sofer
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"


/*
 * Prototypes for the variable hash key methods.
 */

static Tcl_HashEntry *	AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static void		FreeVarEntry(Tcl_HashEntry *hPtr);







>







14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
 * Copyright (c) 2007 Miguel Sofer
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"
#include "tclOOInt.h"

/*
 * Prototypes for the variable hash key methods.
 */

static Tcl_HashEntry *	AllocVarEntry(Tcl_HashTable *tablePtr, void *keyPtr);
static void		FreeVarEntry(Tcl_HashEntry *hPtr);
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772

	part1Ptr->typePtr = &tclParsedVarNameType;
	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
    }

  donePart1:
#if 0
    if (varPtr == NULL) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    part1 = TclGetString(part1Ptr);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
		    "cached variable reference is NULL.", -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);







|







759
760
761
762
763
764
765
766
767
768
769
770
771
772
773

	part1Ptr->typePtr = &tclParsedVarNameType;
	part1Ptr->internalRep.twoPtrValue.ptr1 = NULL;
	part1Ptr->internalRep.twoPtrValue.ptr2 = NULL;
    }

  donePart1:
#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
    if (varPtr == NULL) {
	if (flags & TCL_LEAVE_ERR_MSG) {
	    part1 = TclGetString(part1Ptr);
	    TclObjVarErrMsg(interp, part1Ptr, part2Ptr, msg,
		    "cached variable reference is NULL.", -1);
	    Tcl_SetErrorCode(interp, "TCL", "LOOKUP", "VARNAME",
		    TclGetString(part1Ptr), NULL);
1888
1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
     */

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
#if 0
	/*
	 * Can't happen now!
	 */

	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
	    varPtr->value.objPtr = NULL;







|







1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
     */

    oldValuePtr = varPtr->value.objPtr;
    if (flags & TCL_LIST_ELEMENT && !(flags & TCL_APPEND_VALUE)) {
	varPtr->value.objPtr = NULL;
    }
    if (flags & (TCL_APPEND_VALUE|TCL_LIST_ELEMENT)) {
#if 0 /* ENABLE_NS_VARNAME_CACHING perhaps? */
	/*
	 * Can't happen now!
	 */

	if (TclIsVarUndefined(varPtr) && (oldValuePtr != NULL)) {
	    TclDecrRefCount(oldValuePtr);	/* Discard old value. */
	    varPtr->value.objPtr = NULL;
6079
6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
			    }
			}
		    }
		    varPtr = VarHashNextVar(&search);
		}
	    }
	}
    } else if (((Interp *)interp)->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);







|







6080
6081
6082
6083
6084
6085
6086
6087
6088
6089
6090
6091
6092
6093
6094
			    }
			}
		    }
		    varPtr = VarHashNextVar(&search);
		}
	    }
	}
    } else if (iPtr->varFramePtr->procPtr != NULL) {
	AppendLocals(interp, listPtr, simplePatternPtr, 1);
    }

    if (simplePatternPtr) {
	Tcl_DecrRefCount(simplePatternPtr);
    }
    Tcl_SetObjResult(interp, listPtr);
6265
6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276

6277
6278
6279
6280
6281
6282



6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293



6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317



6318
6319
6320


6321
6322
6323
6324
6325
6326
6327
6328
6329
6330
6331
6332
6333
6334
6335


6336
6337
6338






























6339
6340
6341
6342
6343
6344
6345
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    int i, localVarCt;
    Tcl_Obj **varNamePtr, *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;

    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;




    for (i = 0; i < localVarCt; i++, varNamePtr++) {
	/*
	 * Skip nameless (temporary) variables and undefined variables.
	 */

	if (*varNamePtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    varName = TclGetString(*varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);



	    }
	}
	varPtr++;
    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {
	return;
    }

    /*
     * Check for the simple and fast case.
     */

    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
	if (varPtr != NULL) {
	    if (!TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		Tcl_ListObjAppendElement(interp, listPtr,
			VarHashGetKey(varPtr));



	    }
	}
	return;


    }

    /*
     * Scan over and process all local variables.
     */

    for (varPtr = VarHashFirstVar(localVarTablePtr, &search);
	    varPtr != NULL;
	    varPtr = VarHashNextVar(&search)) {
	if (!TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    objNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(objNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);


	    }
	}
    }






























}

/*
 * Hash table implementation - first, just copy and adapt the obj key stuff
 */

void







|




>






>
>
>











>
>
>










|













>
>
>
|
|
<
>
>















>
>
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







6266
6267
6268
6269
6270
6271
6272
6273
6274
6275
6276
6277
6278
6279
6280
6281
6282
6283
6284
6285
6286
6287
6288
6289
6290
6291
6292
6293
6294
6295
6296
6297
6298
6299
6300
6301
6302
6303
6304
6305
6306
6307
6308
6309
6310
6311
6312
6313
6314
6315
6316
6317
6318
6319
6320
6321
6322
6323
6324
6325
6326
6327
6328
6329
6330

6331
6332
6333
6334
6335
6336
6337
6338
6339
6340
6341
6342
6343
6344
6345
6346
6347
6348
6349
6350
6351
6352
6353
6354
6355
6356
6357
6358
6359
6360
6361
6362
6363
6364
6365
6366
6367
6368
6369
6370
6371
6372
6373
6374
6375
6376
6377
6378
6379
6380
6381
6382
6383
6384
6385
6386
6387
6388
6389
    Tcl_Interp *interp,		/* Current interpreter. */
    Tcl_Obj *listPtr,		/* List object to append names to. */
    Tcl_Obj *patternPtr,	/* Pattern to match against. */
    int includeLinks)		/* 1 if upvars should be included, else 0. */
{
    Interp *iPtr = (Interp *) interp;
    Var *varPtr;
    int i, localVarCt, added;
    Tcl_Obj **varNamePtr, *objNamePtr;
    const char *varName;
    TclVarHashTable *localVarTablePtr;
    Tcl_HashSearch search;
    Tcl_HashTable addedTable;
    const char *pattern = patternPtr? TclGetString(patternPtr) : NULL;

    localVarCt = iPtr->varFramePtr->numCompiledLocals;
    varPtr = iPtr->varFramePtr->compiledLocals;
    localVarTablePtr = iPtr->varFramePtr->varTablePtr;
    varNamePtr = &iPtr->varFramePtr->localCachePtr->varName0;
    if (includeLinks) {
	Tcl_InitObjHashTable(&addedTable);
    }

    for (i = 0; i < localVarCt; i++, varNamePtr++) {
	/*
	 * Skip nameless (temporary) variables and undefined variables.
	 */

	if (*varNamePtr && !TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    varName = TclGetString(*varNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, *varNamePtr);
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, *varNamePtr, &added);
		}
	    }
	}
	varPtr++;
    }

    /*
     * Do nothing if no local variables.
     */

    if (localVarTablePtr == NULL) {
	goto objectVars;
    }

    /*
     * Check for the simple and fast case.
     */

    if ((pattern != NULL) && TclMatchIsTrivial(pattern)) {
	varPtr = VarHashFindVar(localVarTablePtr, patternPtr);
	if (varPtr != NULL) {
	    if (!TclIsVarUndefined(varPtr)
		    && (includeLinks || !TclIsVarLink(varPtr))) {
		Tcl_ListObjAppendElement(interp, listPtr,
			VarHashGetKey(varPtr));
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, VarHashGetKey(varPtr),
			    &added);
		}
	    }

	}
	goto objectVars;
    }

    /*
     * Scan over and process all local variables.
     */

    for (varPtr = VarHashFirstVar(localVarTablePtr, &search);
	    varPtr != NULL;
	    varPtr = VarHashNextVar(&search)) {
	if (!TclIsVarUndefined(varPtr)
		&& (includeLinks || !TclIsVarLink(varPtr))) {
	    objNamePtr = VarHashGetKey(varPtr);
	    varName = TclGetString(objNamePtr);
	    if ((pattern == NULL) || Tcl_StringMatch(varName, pattern)) {
		Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		if (includeLinks) {
		    Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		}
	    }
	}
    }

  objectVars:
    if (!includeLinks) {
	return;
    }

    if (iPtr->varFramePtr->isProcCallFrame & FRAME_IS_METHOD) {
	CallContext *contextPtr = iPtr->varFramePtr->clientData;
	Method *mPtr = contextPtr->callPtr->chain[contextPtr->index].mPtr;

	if (mPtr->declaringObjectPtr) {
	    FOREACH(objNamePtr, mPtr->declaringObjectPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	} else {
	    FOREACH(objNamePtr, mPtr->declaringClassPtr->variables) {
		Tcl_CreateHashEntry(&addedTable, objNamePtr, &added);
		if (added && (!pattern ||
			Tcl_StringMatch(TclGetString(objNamePtr), pattern))) {
		    Tcl_ListObjAppendElement(interp, listPtr, objNamePtr);
		}
	    }
	}
    }
    Tcl_DeleteHashTable(&addedTable);
}

/*
 * Hash table implementation - first, just copy and adapt the obj key stuff
 */

void

Changes to generic/tclZlib.c.

2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504


2505
2506
2507


2508
2509
2510
2511
2512
2513
2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
	}

	/*
	 * Try to actually do the flush now.
	 */

	cd->outStream.avail_in = 0;
	do {
	    int e;

	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
	    cd->outStream.avail_out = cd->outAllocated;

	    e = deflate(&cd->outStream, flushType);


	    if (e != Z_OK) {
		ConvertError(interp, e);
		return TCL_ERROR;


	    }

	    if (cd->outStream.avail_out > 0) {
		if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
			PTR2INT(cd->outStream.next_out)) < 0) {
		    Tcl_AppendResult(interp, "problem flushing channel: ",
			    Tcl_PosixError(interp), NULL);
		    return TCL_ERROR;
		}
	    }
	} while (cd->outStream.avail_out > 0);
	return TCL_OK;
    }

    if (setOptionProc == NULL) {
	return Tcl_BadChannelOption(interp, optionName, chanOptions);
    }








|






>
>
|


>
>


<
|
|
|
|
|
|
|
<







2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
2504
2505
2506
2507
2508
2509
2510
2511
2512
2513

2514
2515
2516
2517
2518
2519
2520

2521
2522
2523
2524
2525
2526
2527
	}

	/*
	 * Try to actually do the flush now.
	 */

	cd->outStream.avail_in = 0;
	while (1) {
	    int e;

	    cd->outStream.next_out = (Bytef *) cd->outBuffer;
	    cd->outStream.avail_out = cd->outAllocated;

	    e = deflate(&cd->outStream, flushType);
	    if (e == Z_BUF_ERROR) {
		break;
	    } else if (e != Z_OK) {
		ConvertError(interp, e);
		return TCL_ERROR;
	    } else if (cd->outStream.avail_out == 0) {
		break;
	    }


	    if (Tcl_WriteRaw(cd->parent, cd->outBuffer,
		    cd->outStream.next_out - (Bytef*)cd->outBuffer) < 0) {
		Tcl_AppendResult(interp, "problem flushing channel: ",
			Tcl_PosixError(interp), NULL);
		return TCL_ERROR;
	    }
	}

	return TCL_OK;
    }

    if (setOptionProc == NULL) {
	return Tcl_BadChannelOption(interp, optionName, chanOptions);
    }

Changes to library/dde/pkgIndex.tcl.

1
2
3
4
5
6
7
if {![package vsatisfies [package provide Tcl] 8]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[info exists ::tcl_platform(debug)]} {
    package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde]
} else {
    package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde]
}
|

|




1
2
3
4
5
6
7
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[::tcl::pkgconfig get debug]} {
    package ifneeded dde 1.3.2 [list load [file join $dir tcldde13g.dll] dde]
} else {
    package ifneeded dde 1.3.2 [list load [file join $dir tcldde13.dll] dde]
}

Changes to library/http/http.tcl.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.3

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {













|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
# http.tcl --
#
#	Client-side HTTP for GET, POST, and HEAD commands. These routines can
#	be used in untrusted code that uses the Safesock security policy.
#	These procedures use a callback interface to avoid using vwait, which
#	is not defined in the safe base.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.6
# Keep this in sync with pkgIndex.tcl and with the install directories in
# Makefiles
package provide http 2.8.4

namespace eval http {
    # Allow resourcing to not clobber existing data

    variable http
    if {![info exists http]} {
	array set http {
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
	# encode all except: "... percent-encoded octets in the ranges of
	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
	# producers ..."
	for {set i 0} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
		set map($c) %[format %.2x $i]
	    }
	}
	# These are handled specially
	set map(\n) %0d%0a
	variable formMap [array get map]

	# Create a map for HTTP/1.1 open sockets
	variable socketmap
	if {[info exists socketmap]} {
	    # Close but don't remove open sockets on re-init
	    foreach {url sock} [array get socketmap] {







|



|







39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
	# encode all except: "... percent-encoded octets in the ranges of
	# ALPHA (%41-%5A and %61-%7A), DIGIT (%30-%39), hyphen (%2D), period
	# (%2E), underscore (%5F), or tilde (%7E) should not be created by URI
	# producers ..."
	for {set i 0} {$i <= 256} {incr i} {
	    set c [format %c $i]
	    if {![string match {[-._~a-zA-Z0-9]} $c]} {
		set map($c) %[format %.2X $i]
	    }
	}
	# These are handled specially
	set map(\n) %0D%0A
	variable formMap [array get map]

	# Create a map for HTTP/1.1 open sockets
	variable socketmap
	if {[info exists socketmap]} {
	    # Close but don't remove open sockets on re-init
	    foreach {url sock} [array get socketmap] {

Changes to library/http/pkgIndex.tcl.

1
2
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded http 2.8.3 [list tclPkgSetup $dir http 2.8.3 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

|
1
2
if {![package vsatisfies [package provide Tcl] 8.6]} {return}
package ifneeded http 2.8.4 [list tclPkgSetup $dir http 2.8.4 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}]

Changes to library/reg/pkgIndex.tcl.

1
2
3
4
5
6
7
8
9
if {![package vsatisfies [package provide Tcl] 8]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[info exists ::tcl_platform(debug)]} {
    package ifneeded registry 1.3 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3 \
            [list load [file join $dir tclreg13.dll] registry]
}
|

|






1
2
3
4
5
6
7
8
9
if {![package vsatisfies [package provide Tcl] 8.5]} {return}
if {[string compare $::tcl_platform(platform) windows]} {return}
if {[::tcl::pkgconfig get debug]} {
    package ifneeded registry 1.3 \
            [list load [file join $dir tclreg13g.dll] registry]
} else {
    package ifneeded registry 1.3 \
            [list load [file join $dir tclreg13.dll] registry]
}

Changes to library/tzdata/Africa/Casablanca.

25
26
27
28
29
30
31
















































































































































































32
    {1220223600 0 0 WET}
    {1243814400 3600 1 WEST}
    {1250809200 0 0 WET}
    {1272758400 3600 1 WEST}
    {1281222000 0 0 WET}
    {1301788800 3600 1 WEST}
    {1312066800 0 0 WET}
















































































































































































}







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

25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
    {1220223600 0 0 WET}
    {1243814400 3600 1 WEST}
    {1250809200 0 0 WET}
    {1272758400 3600 1 WEST}
    {1281222000 0 0 WET}
    {1301788800 3600 1 WEST}
    {1312066800 0 0 WET}
    {1335664800 3600 1 WEST}
    {1348970400 0 0 WET}
    {1367114400 3600 1 WEST}
    {1380420000 0 0 WET}
    {1398564000 3600 1 WEST}
    {1411869600 0 0 WET}
    {1430013600 3600 1 WEST}
    {1443319200 0 0 WET}
    {1461463200 3600 1 WEST}
    {1474768800 0 0 WET}
    {1493517600 3600 1 WEST}
    {1506218400 0 0 WET}
    {1524967200 3600 1 WEST}
    {1538272800 0 0 WET}
    {1556416800 3600 1 WEST}
    {1569722400 0 0 WET}
    {1587866400 3600 1 WEST}
    {1601172000 0 0 WET}
    {1619316000 3600 1 WEST}
    {1632621600 0 0 WET}
    {1650765600 3600 1 WEST}
    {1664071200 0 0 WET}
    {1682820000 3600 1 WEST}
    {1695520800 0 0 WET}
    {1714269600 3600 1 WEST}
    {1727575200 0 0 WET}
    {1745719200 3600 1 WEST}
    {1759024800 0 0 WET}
    {1777168800 3600 1 WEST}
    {1790474400 0 0 WET}
    {1808618400 3600 1 WEST}
    {1821924000 0 0 WET}
    {1840672800 3600 1 WEST}
    {1853373600 0 0 WET}
    {1872122400 3600 1 WEST}
    {1885428000 0 0 WET}
    {1903572000 3600 1 WEST}
    {1916877600 0 0 WET}
    {1935021600 3600 1 WEST}
    {1948327200 0 0 WET}
    {1966471200 3600 1 WEST}
    {1979776800 0 0 WET}
    {1997920800 3600 1 WEST}
    {2011226400 0 0 WET}
    {2029975200 3600 1 WEST}
    {2042676000 0 0 WET}
    {2061424800 3600 1 WEST}
    {2074730400 0 0 WET}
    {2092874400 3600 1 WEST}
    {2106180000 0 0 WET}
    {2124324000 3600 1 WEST}
    {2137629600 0 0 WET}
    {2155773600 3600 1 WEST}
    {2169079200 0 0 WET}
    {2187223200 3600 1 WEST}
    {2200528800 0 0 WET}
    {2219277600 3600 1 WEST}
    {2232583200 0 0 WET}
    {2250727200 3600 1 WEST}
    {2264032800 0 0 WET}
    {2282176800 3600 1 WEST}
    {2295482400 0 0 WET}
    {2313626400 3600 1 WEST}
    {2326932000 0 0 WET}
    {2345076000 3600 1 WEST}
    {2358381600 0 0 WET}
    {2377130400 3600 1 WEST}
    {2389831200 0 0 WET}
    {2408580000 3600 1 WEST}
    {2421885600 0 0 WET}
    {2440029600 3600 1 WEST}
    {2453335200 0 0 WET}
    {2471479200 3600 1 WEST}
    {2484784800 0 0 WET}
    {2502928800 3600 1 WEST}
    {2516234400 0 0 WET}
    {2534378400 3600 1 WEST}
    {2547684000 0 0 WET}
    {2566432800 3600 1 WEST}
    {2579133600 0 0 WET}
    {2597882400 3600 1 WEST}
    {2611188000 0 0 WET}
    {2629332000 3600 1 WEST}
    {2642637600 0 0 WET}
    {2660781600 3600 1 WEST}
    {2674087200 0 0 WET}
    {2692231200 3600 1 WEST}
    {2705536800 0 0 WET}
    {2724285600 3600 1 WEST}
    {2736986400 0 0 WET}
    {2755735200 3600 1 WEST}
    {2769040800 0 0 WET}
    {2787184800 3600 1 WEST}
    {2800490400 0 0 WET}
    {2818634400 3600 1 WEST}
    {2831940000 0 0 WET}
    {2850084000 3600 1 WEST}
    {2863389600 0 0 WET}
    {2881533600 3600 1 WEST}
    {2894839200 0 0 WET}
    {2913588000 3600 1 WEST}
    {2926288800 0 0 WET}
    {2945037600 3600 1 WEST}
    {2958343200 0 0 WET}
    {2976487200 3600 1 WEST}
    {2989792800 0 0 WET}
    {3007936800 3600 1 WEST}
    {3021242400 0 0 WET}
    {3039386400 3600 1 WEST}
    {3052692000 0 0 WET}
    {3070836000 3600 1 WEST}
    {3084141600 0 0 WET}
    {3102890400 3600 1 WEST}
    {3116196000 0 0 WET}
    {3134340000 3600 1 WEST}
    {3147645600 0 0 WET}
    {3165789600 3600 1 WEST}
    {3179095200 0 0 WET}
    {3197239200 3600 1 WEST}
    {3210544800 0 0 WET}
    {3228688800 3600 1 WEST}
    {3241994400 0 0 WET}
    {3260743200 3600 1 WEST}
    {3273444000 0 0 WET}
    {3292192800 3600 1 WEST}
    {3305498400 0 0 WET}
    {3323642400 3600 1 WEST}
    {3336948000 0 0 WET}
    {3355092000 3600 1 WEST}
    {3368397600 0 0 WET}
    {3386541600 3600 1 WEST}
    {3399847200 0 0 WET}
    {3417991200 3600 1 WEST}
    {3431296800 0 0 WET}
    {3450045600 3600 1 WEST}
    {3462746400 0 0 WET}
    {3481495200 3600 1 WEST}
    {3494800800 0 0 WET}
    {3512944800 3600 1 WEST}
    {3526250400 0 0 WET}
    {3544394400 3600 1 WEST}
    {3557700000 0 0 WET}
    {3575844000 3600 1 WEST}
    {3589149600 0 0 WET}
    {3607898400 3600 1 WEST}
    {3620599200 0 0 WET}
    {3639348000 3600 1 WEST}
    {3652653600 0 0 WET}
    {3670797600 3600 1 WEST}
    {3684103200 0 0 WET}
    {3702247200 3600 1 WEST}
    {3715552800 0 0 WET}
    {3733696800 3600 1 WEST}
    {3747002400 0 0 WET}
    {3765146400 3600 1 WEST}
    {3778452000 0 0 WET}
    {3797200800 3600 1 WEST}
    {3809901600 0 0 WET}
    {3828650400 3600 1 WEST}
    {3841956000 0 0 WET}
    {3860100000 3600 1 WEST}
    {3873405600 0 0 WET}
    {3891549600 3600 1 WEST}
    {3904855200 0 0 WET}
    {3922999200 3600 1 WEST}
    {3936304800 0 0 WET}
    {3954448800 3600 1 WEST}
    {3967754400 0 0 WET}
    {3986503200 3600 1 WEST}
    {3999808800 0 0 WET}
    {4017952800 3600 1 WEST}
    {4031258400 0 0 WET}
    {4049402400 3600 1 WEST}
    {4062708000 0 0 WET}
    {4080852000 3600 1 WEST}
    {4094157600 0 0 WET}
}

Changes to library/tzdata/America/Atikokan.

1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Atikokan) {
    {-9223372036854775808 -21988 0 LMT}
    {-2366733212 -21600 0 CST}
    {-1632067200 -18000 1 CDT}
    {-1614790800 -21600 0 CST}
    {-923248800 -18000 1 CDT}
    {-880214400 -18000 0 CWT}
    {-769395600 -18000 1 CPT}
    {-765388800 -18000 0 EST}
}






|





1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Atikokan) {
    {-9223372036854775808 -21988 0 LMT}
    {-2366733212 -21600 0 CST}
    {-1632067200 -18000 1 CDT}
    {-1615136400 -21600 0 CST}
    {-923248800 -18000 1 CDT}
    {-880214400 -18000 0 CWT}
    {-769395600 -18000 1 CPT}
    {-765388800 -18000 0 EST}
}

Changes to library/tzdata/America/Blanc-Sablon.

1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Blanc-Sablon) {
    {-9223372036854775808 -13708 0 LMT}
    {-2713896692 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1614798000 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {14400 -14400 0 AST}
}






|





1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Blanc-Sablon) {
    {-9223372036854775808 -13708 0 LMT}
    {-2713896692 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1615143600 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {14400 -14400 0 AST}
}

Added library/tzdata/America/Creston.

















>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Creston) {
    {-9223372036854775808 -27964 0 LMT}
    {-2713882436 -25200 0 MST}
    {-1680454800 -28800 0 PST}
    {-1627833600 -25200 0 MST}
}

Changes to library/tzdata/America/Dawson_Creek.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Dawson_Creek) {
    {-9223372036854775808 -28856 0 LMT}
    {-2713881544 -28800 0 PST}
    {-1632060000 -25200 1 PDT}
    {-1614783600 -28800 0 PST}
    {-880207200 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-765385200 -28800 0 PST}
    {-725817600 -28800 0 PST}
    {-715788000 -25200 1 PDT}
    {-702486000 -28800 0 PST}
    {-684338400 -25200 1 PDT}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Dawson_Creek) {
    {-9223372036854775808 -28856 0 LMT}
    {-2713881544 -28800 0 PST}
    {-1632060000 -25200 1 PDT}
    {-1615129200 -28800 0 PST}
    {-880207200 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-765385200 -28800 0 PST}
    {-725817600 -28800 0 PST}
    {-715788000 -25200 1 PDT}
    {-702486000 -28800 0 PST}
    {-684338400 -25200 1 PDT}

Changes to library/tzdata/America/Edmonton.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Edmonton) {
    {-9223372036854775808 -27232 0 LMT}
    {-1998663968 -25200 0 MST}
    {-1632063600 -21600 1 MDT}
    {-1614787200 -25200 0 MST}
    {-1600614000 -21600 1 MDT}
    {-1596816000 -25200 0 MST}
    {-1567954800 -21600 1 MDT}
    {-1551628800 -25200 0 MST}
    {-1536505200 -21600 1 MDT}
    {-1523203200 -25200 0 MST}
    {-1504450800 -21600 1 MDT}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Edmonton) {
    {-9223372036854775808 -27232 0 LMT}
    {-1998663968 -25200 0 MST}
    {-1632063600 -21600 1 MDT}
    {-1615132800 -25200 0 MST}
    {-1600614000 -21600 1 MDT}
    {-1596816000 -25200 0 MST}
    {-1567954800 -21600 1 MDT}
    {-1551628800 -25200 0 MST}
    {-1536505200 -21600 1 MDT}
    {-1523203200 -25200 0 MST}
    {-1504450800 -21600 1 MDT}

Changes to library/tzdata/America/Glace_Bay.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Glace_Bay) {
    {-9223372036854775808 -14388 0 LMT}
    {-2131646412 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1614798000 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {-536443200 -14400 0 AST}
    {-526500000 -10800 1 ADT}
    {-513198000 -14400 0 AST}
    {-504907200 -14400 0 AST}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Glace_Bay) {
    {-9223372036854775808 -14388 0 LMT}
    {-2131646412 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1615143600 -14400 0 AST}
    {-880221600 -10800 1 AWT}
    {-769395600 -10800 1 APT}
    {-765399600 -14400 0 AST}
    {-536443200 -14400 0 AST}
    {-526500000 -10800 1 ADT}
    {-513198000 -14400 0 AST}
    {-504907200 -14400 0 AST}

Changes to library/tzdata/America/Goose_Bay.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Goose_Bay) {
    {-9223372036854775808 -14500 0 LMT}
    {-2713895900 -12652 0 NST}
    {-1640982548 -12652 0 NST}
    {-1632076148 -9052 1 NDT}
    {-1614799748 -12652 0 NST}
    {-1609446548 -12652 0 NST}
    {-1096921748 -12600 0 NST}
    {-1072989000 -12600 0 NST}
    {-1061670600 -9000 1 NDT}
    {-1048973400 -12600 0 NST}
    {-1030221000 -9000 1 NDT}
    {-1017523800 -12600 0 NST}







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Goose_Bay) {
    {-9223372036854775808 -14500 0 LMT}
    {-2713895900 -12652 0 NST}
    {-1640982548 -12652 0 NST}
    {-1632076148 -9052 1 NDT}
    {-1615145348 -12652 0 NST}
    {-1609446548 -12652 0 NST}
    {-1096921748 -12600 0 NST}
    {-1072989000 -12600 0 NST}
    {-1061670600 -9000 1 NDT}
    {-1048973400 -12600 0 NST}
    {-1030221000 -9000 1 NDT}
    {-1017523800 -12600 0 NST}

Changes to library/tzdata/America/Halifax.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Halifax) {
    {-9223372036854775808 -15264 0 LMT}
    {-2131645536 -14400 0 AST}
    {-1696276800 -10800 1 ADT}
    {-1680469200 -14400 0 AST}
    {-1640980800 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1614798000 -14400 0 AST}
    {-1609444800 -14400 0 AST}
    {-1566763200 -10800 1 ADT}
    {-1557090000 -14400 0 AST}
    {-1535486400 -10800 1 ADT}
    {-1524949200 -14400 0 AST}
    {-1504468800 -10800 1 ADT}
    {-1493413200 -14400 0 AST}









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Halifax) {
    {-9223372036854775808 -15264 0 LMT}
    {-2131645536 -14400 0 AST}
    {-1696276800 -10800 1 ADT}
    {-1680469200 -14400 0 AST}
    {-1640980800 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1615143600 -14400 0 AST}
    {-1609444800 -14400 0 AST}
    {-1566763200 -10800 1 ADT}
    {-1557090000 -14400 0 AST}
    {-1535486400 -10800 1 ADT}
    {-1524949200 -14400 0 AST}
    {-1504468800 -10800 1 ADT}
    {-1493413200 -14400 0 AST}

Changes to library/tzdata/America/Havana.

102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    {1224997200 -18000 0 CST}
    {1236488400 -14400 1 CDT}
    {1256446800 -18000 0 CST}
    {1268542800 -14400 1 CDT}
    {1288501200 -18000 0 CST}
    {1300597200 -14400 1 CDT}
    {1321160400 -18000 0 CST}
    {1331442000 -14400 1 CDT}
    {1351400400 -18000 0 CST}
    {1362891600 -14400 1 CDT}
    {1382850000 -18000 0 CST}
    {1394341200 -14400 1 CDT}
    {1414299600 -18000 0 CST}
    {1425790800 -14400 1 CDT}
    {1445749200 -18000 0 CST}







|







102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
    {1224997200 -18000 0 CST}
    {1236488400 -14400 1 CDT}
    {1256446800 -18000 0 CST}
    {1268542800 -14400 1 CDT}
    {1288501200 -18000 0 CST}
    {1300597200 -14400 1 CDT}
    {1321160400 -18000 0 CST}
    {1333256400 -14400 1 CDT}
    {1351400400 -18000 0 CST}
    {1362891600 -14400 1 CDT}
    {1382850000 -18000 0 CST}
    {1394341200 -14400 1 CDT}
    {1414299600 -18000 0 CST}
    {1425790800 -14400 1 CDT}
    {1445749200 -18000 0 CST}

Changes to library/tzdata/America/Moncton.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Moncton) {
    {-9223372036854775808 -15548 0 LMT}
    {-2715882052 -18000 0 EST}
    {-2131642800 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1614798000 -14400 0 AST}
    {-1167595200 -14400 0 AST}
    {-1153681200 -10800 1 ADT}
    {-1145822400 -14400 0 AST}
    {-1122231600 -10800 1 ADT}
    {-1114372800 -14400 0 AST}
    {-1090782000 -10800 1 ADT}
    {-1082923200 -14400 0 AST}







|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Moncton) {
    {-9223372036854775808 -15548 0 LMT}
    {-2715882052 -18000 0 EST}
    {-2131642800 -14400 0 AST}
    {-1632074400 -10800 1 ADT}
    {-1615143600 -14400 0 AST}
    {-1167595200 -14400 0 AST}
    {-1153681200 -10800 1 ADT}
    {-1145822400 -14400 0 AST}
    {-1122231600 -10800 1 ADT}
    {-1114372800 -14400 0 AST}
    {-1090782000 -10800 1 ADT}
    {-1082923200 -14400 0 AST}

Changes to library/tzdata/America/Montreal.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Montreal) {
    {-9223372036854775808 -17656 0 LMT}
    {-2713892744 -18000 0 EST}
    {-1665334800 -14400 1 EDT}
    {-1662753600 -18000 0 EST}
    {-1640977200 -18000 0 EST}
    {-1632070800 -14400 1 EDT}
    {-1614794400 -18000 0 EST}
    {-1609441200 -18000 0 EST}
    {-1601742600 -14400 1 EDT}
    {-1583775000 -18000 0 EST}
    {-1567355400 -14400 1 EDT}
    {-1554053400 -18000 0 EST}
    {-1535907600 -14400 1 EDT}
    {-1522603800 -18000 0 EST}









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Montreal) {
    {-9223372036854775808 -17656 0 LMT}
    {-2713892744 -18000 0 EST}
    {-1665334800 -14400 1 EDT}
    {-1662753600 -18000 0 EST}
    {-1640977200 -18000 0 EST}
    {-1632070800 -14400 1 EDT}
    {-1615140000 -18000 0 EST}
    {-1609441200 -18000 0 EST}
    {-1601742600 -14400 1 EDT}
    {-1583775000 -18000 0 EST}
    {-1567355400 -14400 1 EDT}
    {-1554053400 -18000 0 EST}
    {-1535907600 -14400 1 EDT}
    {-1522603800 -18000 0 EST}

Changes to library/tzdata/America/Nipigon.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Nipigon) {
    {-9223372036854775808 -21184 0 LMT}
    {-2366734016 -18000 0 EST}
    {-1632070800 -14400 1 EDT}
    {-1614794400 -18000 0 EST}
    {-923252400 -14400 1 EDT}
    {-880218000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {136364400 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {167814000 -14400 1 EDT}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Nipigon) {
    {-9223372036854775808 -21184 0 LMT}
    {-2366734016 -18000 0 EST}
    {-1632070800 -14400 1 EDT}
    {-1615140000 -18000 0 EST}
    {-923252400 -14400 1 EDT}
    {-880218000 -14400 0 EWT}
    {-769395600 -14400 1 EPT}
    {-765396000 -18000 0 EST}
    {136364400 -14400 1 EDT}
    {152085600 -18000 0 EST}
    {167814000 -14400 1 EDT}

Changes to library/tzdata/America/Port-au-Prince.

34
35
36
37
38
39
40


41
    {846396000 -18000 0 EST}
    {860306400 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {1112504400 -14400 1 EDT}
    {1130644800 -18000 0 EST}
    {1143954000 -14400 1 EDT}
    {1162094400 -18000 0 EST}


}







>
>

34
35
36
37
38
39
40
41
42
43
    {846396000 -18000 0 EST}
    {860306400 -14400 1 EDT}
    {877845600 -18000 0 EST}
    {1112504400 -14400 1 EDT}
    {1130644800 -18000 0 EST}
    {1143954000 -14400 1 EDT}
    {1162094400 -18000 0 EST}
    {1331449200 -14400 1 EDT}
    {1352008800 -18000 0 EST}
}

Changes to library/tzdata/America/Rainy_River.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rainy_River) {
    {-9223372036854775808 -22696 0 LMT}
    {-2366732504 -21600 0 CST}
    {-1632067200 -18000 1 CDT}
    {-1614790800 -21600 0 CST}
    {-923248800 -18000 1 CDT}
    {-880214400 -18000 0 CWT}
    {-769395600 -18000 1 CPT}
    {-765392400 -21600 0 CST}
    {136368000 -18000 1 CDT}
    {152089200 -21600 0 CST}
    {167817600 -18000 1 CDT}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Rainy_River) {
    {-9223372036854775808 -22696 0 LMT}
    {-2366732504 -21600 0 CST}
    {-1632067200 -18000 1 CDT}
    {-1615136400 -21600 0 CST}
    {-923248800 -18000 1 CDT}
    {-880214400 -18000 0 CWT}
    {-769395600 -18000 1 CPT}
    {-765392400 -21600 0 CST}
    {136368000 -18000 1 CDT}
    {152089200 -21600 0 CST}
    {167817600 -18000 1 CDT}

Changes to library/tzdata/America/Regina.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Regina) {
    {-9223372036854775808 -25116 0 LMT}
    {-2030202084 -25200 0 MST}
    {-1632063600 -21600 1 MDT}
    {-1614787200 -25200 0 MST}
    {-1251651600 -21600 1 MDT}
    {-1238349600 -25200 0 MST}
    {-1220202000 -21600 1 MDT}
    {-1206900000 -25200 0 MST}
    {-1188752400 -21600 1 MDT}
    {-1175450400 -25200 0 MST}
    {-1156698000 -21600 1 MDT}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Regina) {
    {-9223372036854775808 -25116 0 LMT}
    {-2030202084 -25200 0 MST}
    {-1632063600 -21600 1 MDT}
    {-1615132800 -25200 0 MST}
    {-1251651600 -21600 1 MDT}
    {-1238349600 -25200 0 MST}
    {-1220202000 -21600 1 MDT}
    {-1206900000 -25200 0 MST}
    {-1188752400 -21600 1 MDT}
    {-1175450400 -25200 0 MST}
    {-1156698000 -21600 1 MDT}

Changes to library/tzdata/America/Santiago.

108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    {1223784000 -10800 1 CLST}
    {1237086000 -14400 0 CLT}
    {1255233600 -10800 1 CLST}
    {1270350000 -14400 0 CLT}
    {1286683200 -10800 1 CLST}
    {1304823600 -14400 0 CLT}
    {1313899200 -10800 1 CLST}
    {1331434800 -14400 0 CLT}
    {1350187200 -10800 1 CLST}
    {1362884400 -14400 0 CLT}
    {1381636800 -10800 1 CLST}
    {1394334000 -14400 0 CLT}
    {1413086400 -10800 1 CLST}
    {1426388400 -14400 0 CLT}
    {1444536000 -10800 1 CLST}
    {1457838000 -14400 0 CLT}







|
|







108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
    {1223784000 -10800 1 CLST}
    {1237086000 -14400 0 CLT}
    {1255233600 -10800 1 CLST}
    {1270350000 -14400 0 CLT}
    {1286683200 -10800 1 CLST}
    {1304823600 -14400 0 CLT}
    {1313899200 -10800 1 CLST}
    {1335668400 -14400 0 CLT}
    {1346558400 -10800 1 CLST}
    {1362884400 -14400 0 CLT}
    {1381636800 -10800 1 CLST}
    {1394334000 -14400 0 CLT}
    {1413086400 -10800 1 CLST}
    {1426388400 -14400 0 CLT}
    {1444536000 -10800 1 CLST}
    {1457838000 -14400 0 CLT}

Changes to library/tzdata/America/St_Johns.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/St_Johns) {
    {-9223372036854775808 -12652 0 LMT}
    {-2713897748 -12652 0 NST}
    {-1664130548 -9052 1 NDT}
    {-1650137348 -12652 0 NST}
    {-1640982548 -12652 0 NST}
    {-1632076148 -9052 1 NDT}
    {-1614799748 -12652 0 NST}
    {-1609446548 -12652 0 NST}
    {-1598650148 -9052 1 NDT}
    {-1590100148 -12652 0 NST}
    {-1567286948 -9052 1 NDT}
    {-1551565748 -12652 0 NST}
    {-1535837348 -9052 1 NDT}
    {-1520116148 -12652 0 NST}









|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/St_Johns) {
    {-9223372036854775808 -12652 0 LMT}
    {-2713897748 -12652 0 NST}
    {-1664130548 -9052 1 NDT}
    {-1650137348 -12652 0 NST}
    {-1640982548 -12652 0 NST}
    {-1632076148 -9052 1 NDT}
    {-1615145348 -12652 0 NST}
    {-1609446548 -12652 0 NST}
    {-1598650148 -9052 1 NDT}
    {-1590100148 -12652 0 NST}
    {-1567286948 -9052 1 NDT}
    {-1551565748 -12652 0 NST}
    {-1535837348 -9052 1 NDT}
    {-1520116148 -12652 0 NST}

Changes to library/tzdata/America/Swift_Current.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Swift_Current) {
    {-9223372036854775808 -25880 0 LMT}
    {-2030201320 -25200 0 MST}
    {-1632063600 -21600 1 MDT}
    {-1614787200 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-747241200 -21600 0 MDT}
    {-732729600 -25200 0 MST}
    {-715791600 -21600 1 MDT}
    {-702489600 -25200 0 MST}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Swift_Current) {
    {-9223372036854775808 -25880 0 LMT}
    {-2030201320 -25200 0 MST}
    {-1632063600 -21600 1 MDT}
    {-1615132800 -25200 0 MST}
    {-880210800 -21600 1 MWT}
    {-769395600 -21600 1 MPT}
    {-765388800 -25200 0 MST}
    {-747241200 -21600 0 MDT}
    {-732729600 -25200 0 MST}
    {-715791600 -21600 1 MDT}
    {-702489600 -25200 0 MST}

Changes to library/tzdata/America/Toronto.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Toronto) {
    {-9223372036854775808 -19052 0 LMT}
    {-2366736148 -18000 0 EST}
    {-1632070800 -14400 1 EDT}
    {-1614794400 -18000 0 EST}
    {-1609441200 -18000 0 EST}
    {-1601753400 -14400 1 EDT}
    {-1583697600 -18000 0 EST}
    {-1567357200 -14400 1 EDT}
    {-1554667200 -18000 0 EST}
    {-1534698000 -14400 1 EDT}
    {-1524074400 -18000 0 EST}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Toronto) {
    {-9223372036854775808 -19052 0 LMT}
    {-2366736148 -18000 0 EST}
    {-1632070800 -14400 1 EDT}
    {-1615140000 -18000 0 EST}
    {-1609441200 -18000 0 EST}
    {-1601753400 -14400 1 EDT}
    {-1583697600 -18000 0 EST}
    {-1567357200 -14400 1 EDT}
    {-1554667200 -18000 0 EST}
    {-1534698000 -14400 1 EDT}
    {-1524074400 -18000 0 EST}

Changes to library/tzdata/America/Vancouver.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Vancouver) {
    {-9223372036854775808 -29548 0 LMT}
    {-2713880852 -28800 0 PST}
    {-1632060000 -25200 1 PDT}
    {-1614783600 -28800 0 PST}
    {-880207200 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-765385200 -28800 0 PST}
    {-747237600 -25200 1 PDT}
    {-732726000 -28800 0 PST}
    {-715788000 -25200 1 PDT}
    {-702486000 -28800 0 PST}






|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Vancouver) {
    {-9223372036854775808 -29548 0 LMT}
    {-2713880852 -28800 0 PST}
    {-1632060000 -25200 1 PDT}
    {-1615129200 -28800 0 PST}
    {-880207200 -25200 1 PWT}
    {-769395600 -25200 1 PPT}
    {-765385200 -28800 0 PST}
    {-747237600 -25200 1 PDT}
    {-732726000 -28800 0 PST}
    {-715788000 -25200 1 PDT}
    {-702486000 -28800 0 PST}

Changes to library/tzdata/America/Winnipeg.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Winnipeg) {
    {-9223372036854775808 -23316 0 LMT}
    {-2602258284 -21600 0 CST}
    {-1694368800 -18000 1 CDT}
    {-1681671600 -21600 0 CST}
    {-1632067200 -18000 1 CDT}
    {-1614790800 -21600 0 CST}
    {-1029686400 -18000 1 CDT}
    {-1018198800 -21600 0 CST}
    {-880214400 -18000 1 CWT}
    {-769395600 -18000 1 CPT}
    {-765392400 -21600 0 CST}
    {-746035200 -18000 1 CDT}
    {-732733200 -21600 0 CST}








|







1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
# created by tools/tclZIC.tcl - do not edit

set TZData(:America/Winnipeg) {
    {-9223372036854775808 -23316 0 LMT}
    {-2602258284 -21600 0 CST}
    {-1694368800 -18000 1 CDT}
    {-1681671600 -21600 0 CST}
    {-1632067200 -18000 1 CDT}
    {-1615136400 -21600 0 CST}
    {-1029686400 -18000 1 CDT}
    {-1018198800 -21600 0 CST}
    {-880214400 -18000 1 CWT}
    {-769395600 -18000 1 CPT}
    {-765392400 -21600 0 CST}
    {-746035200 -18000 1 CDT}
    {-732733200 -21600 0 CST}

Changes to library/tzdata/Antarctica/Casey.

1
2
3
4
5
6
7


8
# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Casey) {
    {-9223372036854775808 0 0 zzz}
    {-31536000 28800 0 WST}
    {1255802400 39600 0 CAST}
    {1267714800 28800 0 WST}


}







>
>

1
2
3
4
5
6
7
8
9
10
# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Casey) {
    {-9223372036854775808 0 0 zzz}
    {-31536000 28800 0 WST}
    {1255802400 39600 0 CAST}
    {1267714800 28800 0 WST}
    {1319738400 39600 0 CAST}
    {1329843600 28800 0 WST}
}

Changes to library/tzdata/Antarctica/Davis.

1
2
3
4
5
6
7
8
9


10
# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Davis) {
    {-9223372036854775808 0 0 zzz}
    {-409190400 25200 0 DAVT}
    {-163062000 0 0 zzz}
    {-28857600 25200 0 DAVT}
    {1255806000 18000 0 DAVT}
    {1268251200 25200 0 DAVT}


}









>
>

1
2
3
4
5
6
7
8
9
10
11
12
# created by tools/tclZIC.tcl - do not edit

set TZData(:Antarctica/Davis) {
    {-9223372036854775808 0 0 zzz}
    {-409190400 25200 0 DAVT}
    {-163062000 0 0 zzz}
    {-28857600 25200 0 DAVT}
    {1255806000 18000 0 DAVT}
    {1268251200 25200 0 DAVT}
    {1319742000 18000 0 DAVT}
    {1329854400 25200 0 DAVT}
}

Changes to library/tzdata/Antarctica/Palmer.

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
    {1097380800 -10800 1 CLST}
    {1110682800 -14400 0 CLT}
    {1128830400 -10800 1 CLST}
    {1142132400 -14400 0 CLT}
    {1160884800 -10800 1 CLST}
    {1173582000 -14400 0 CLT}
    {1192334400 -10800 1 CLST}
    {1205031600 -14400 0 CLT}
    {1223784000 -10800 1 CLST}
    {1237086000 -14400 0 CLT}
    {1255233600 -10800 1 CLST}
    {1268535600 -14400 0 CLT}
    {1286683200 -10800 1 CLST}
    {1299985200 -14400 0 CLT}
    {1318132800 -10800 1 CLST}
    {1331434800 -14400 0 CLT}
    {1350187200 -10800 1 CLST}
    {1362884400 -14400 0 CLT}
    {1381636800 -10800 1 CLST}
    {1394334000 -14400 0 CLT}
    {1413086400 -10800 1 CLST}
    {1426388400 -14400 0 CLT}
    {1444536000 -10800 1 CLST}
    {1457838000 -14400 0 CLT}







|



|

|
|
|
|







63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
    {1097380800 -10800 1 CLST}
    {1110682800 -14400 0 CLT}
    {1128830400 -10800 1 CLST}
    {1142132400 -14400 0 CLT}
    {1160884800 -10800 1 CLST}
    {1173582000 -14400 0 CLT}
    {1192334400 -10800 1 CLST}
    {1206846000 -14400 0 CLT}
    {1223784000 -10800 1 CLST}
    {1237086000 -14400 0 CLT}
    {1255233600 -10800 1 CLST}
    {1270350000 -14400 0 CLT}
    {1286683200 -10800 1 CLST}
    {1304823600 -14400 0 CLT}
    {1313899200 -10800 1 CLST}
    {1335668400 -14400 0 CLT}
    {1346558400 -10800 1 CLST}
    {1362884400 -14400 0 CLT}
    {1381636800 -10800 1 CLST}
    {1394334000 -14400 0 CLT}
    {1413086400 -10800 1 CLST}
    {1426388400 -14400 0 CLT}
    {1444536000 -10800 1 CLST}
    {1457838000 -14400 0 CLT}

Changes to library/tzdata/Asia/Damascus.

97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
    {1225486800 7200 0 EET}
    {1238104800 10800 1 EEST}
    {1256850000 7200 0 EET}
    {1270159200 10800 1 EEST}
    {1288299600 7200 0 EET}
    {1301608800 10800 1 EEST}
    {1319749200 7200 0 EET}
    {1333663200 10800 1 EEST}
    {1351198800 7200 0 EET}
    {1365112800 10800 1 EEST}
    {1382648400 7200 0 EET}
    {1396562400 10800 1 EEST}
    {1414702800 7200 0 EET}
    {1428012000 10800 1 EEST}
    {1446152400 7200 0 EET}
    {1459461600 10800 1 EEST}
    {1477602000 7200 0 EET}
    {1491516000 10800 1 EEST}
    {1509051600 7200 0 EET}
    {1522965600 10800 1 EEST}
    {1540501200 7200 0 EET}
    {1554415200 10800 1 EEST}
    {1571950800 7200 0 EET}
    {1585864800 10800 1 EEST}
    {1604005200 7200 0 EET}
    {1617314400 10800 1 EEST}
    {1635454800 7200 0 EET}
    {1648764000 10800 1 EEST}
    {1666904400 7200 0 EET}
    {1680818400 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1712268000 10800 1 EEST}
    {1729803600 7200 0 EET}
    {1743717600 10800 1 EEST}
    {1761858000 7200 0 EET}
    {1775167200 10800 1 EEST}
    {1793307600 7200 0 EET}
    {1806616800 10800 1 EEST}
    {1824757200 7200 0 EET}
    {1838671200 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1870120800 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1901570400 10800 1 EEST}
    {1919106000 7200 0 EET}
    {1933020000 10800 1 EEST}
    {1951160400 7200 0 EET}
    {1964469600 10800 1 EEST}
    {1982610000 7200 0 EET}
    {1995919200 10800 1 EEST}
    {2014059600 7200 0 EET}
    {2027973600 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2059423200 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2090872800 10800 1 EEST}
    {2109013200 7200 0 EET}
    {2122322400 10800 1 EEST}
    {2140462800 7200 0 EET}
    {2153772000 10800 1 EEST}
    {2171912400 7200 0 EET}
    {2185221600 10800 1 EEST}
    {2203362000 7200 0 EET}
    {2217276000 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2248725600 10800 1 EEST}
    {2266261200 7200 0 EET}
    {2280175200 10800 1 EEST}
    {2298315600 7200 0 EET}
    {2311624800 10800 1 EEST}
    {2329765200 7200 0 EET}
    {2343074400 10800 1 EEST}
    {2361214800 7200 0 EET}
    {2375128800 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2406578400 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2438028000 10800 1 EEST}
    {2455563600 7200 0 EET}
    {2469477600 10800 1 EEST}
    {2487618000 7200 0 EET}
    {2500927200 10800 1 EEST}
    {2519067600 7200 0 EET}
    {2532376800 10800 1 EEST}
    {2550517200 7200 0 EET}
    {2564431200 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2595880800 10800 1 EEST}
    {2613416400 7200 0 EET}
    {2627330400 10800 1 EEST}
    {2645470800 7200 0 EET}
    {2658780000 10800 1 EEST}
    {2676920400 7200 0 EET}
    {2690229600 10800 1 EEST}
    {2708370000 7200 0 EET}
    {2722284000 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2753733600 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2785183200 10800 1 EEST}
    {2802718800 7200 0 EET}
    {2816632800 10800 1 EEST}
    {2834773200 7200 0 EET}
    {2848082400 10800 1 EEST}
    {2866222800 7200 0 EET}
    {2879532000 10800 1 EEST}
    {2897672400 7200 0 EET}
    {2911586400 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2943036000 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2974485600 10800 1 EEST}
    {2992626000 7200 0 EET}
    {3005935200 10800 1 EEST}
    {3024075600 7200 0 EET}
    {3037384800 10800 1 EEST}
    {3055525200 7200 0 EET}
    {3068834400 10800 1 EEST}
    {3086974800 7200 0 EET}
    {3100888800 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3132338400 10800 1 EEST}
    {3149874000 7200 0 EET}
    {3163788000 10800 1 EEST}
    {3181928400 7200 0 EET}
    {3195237600 10800 1 EEST}
    {3213378000 7200 0 EET}
    {3226687200 10800 1 EEST}
    {3244827600 7200 0 EET}
    {3258741600 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3290191200 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3321640800 10800 1 EEST}
    {3339176400 7200 0 EET}
    {3353090400 10800 1 EEST}
    {3371230800 7200 0 EET}
    {3384540000 10800 1 EEST}
    {3402680400 7200 0 EET}
    {3415989600 10800 1 EEST}
    {3434130000 7200 0 EET}
    {3448044000 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3479493600 10800 1 EEST}
    {3497029200 7200 0 EET}
    {3510943200 10800 1 EEST}
    {3529083600 7200 0 EET}
    {3542392800 10800 1 EEST}
    {3560533200 7200 0 EET}
    {3573842400 10800 1 EEST}
    {3591982800 7200 0 EET}
    {3605896800 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3637346400 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3668796000 10800 1 EEST}
    {3686331600 7200 0 EET}
    {3700245600 10800 1 EEST}
    {3718386000 7200 0 EET}
    {3731695200 10800 1 EEST}
    {3749835600 7200 0 EET}
    {3763144800 10800 1 EEST}
    {3781285200 7200 0 EET}
    {3795199200 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3826648800 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3858098400 10800 1 EEST}
    {3876238800 7200 0 EET}
    {3889548000 10800 1 EEST}
    {3907688400 7200 0 EET}
    {3920997600 10800 1 EEST}
    {3939138000 7200 0 EET}
    {3952447200 10800 1 EEST}
    {3970587600 7200 0 EET}
    {3984501600 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4015951200 10800 1 EEST}
    {4033486800 7200 0 EET}
    {4047400800 10800 1 EEST}
    {4065541200 7200 0 EET}
    {4078850400 10800 1 EEST}
    {4096990800 7200 0 EET}
}







|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|

|


97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
    {1225486800 7200 0 EET}
    {1238104800 10800 1 EEST}
    {1256850000 7200 0 EET}
    {1270159200 10800 1 EEST}
    {1288299600 7200 0 EET}
    {1301608800 10800 1 EEST}
    {1319749200 7200 0 EET}
    {1333058400 10800 1 EEST}
    {1351198800 7200 0 EET}
    {1364508000 10800 1 EEST}
    {1382648400 7200 0 EET}
    {1395957600 10800 1 EEST}
    {1414702800 7200 0 EET}
    {1427407200 10800 1 EEST}
    {1446152400 7200 0 EET}
    {1458856800 10800 1 EEST}
    {1477602000 7200 0 EET}
    {1490911200 10800 1 EEST}
    {1509051600 7200 0 EET}
    {1522360800 10800 1 EEST}
    {1540501200 7200 0 EET}
    {1553810400 10800 1 EEST}
    {1571950800 7200 0 EET}
    {1585260000 10800 1 EEST}
    {1604005200 7200 0 EET}
    {1616709600 10800 1 EEST}
    {1635454800 7200 0 EET}
    {1648159200 10800 1 EEST}
    {1666904400 7200 0 EET}
    {1680213600 10800 1 EEST}
    {1698354000 7200 0 EET}
    {1711663200 10800 1 EEST}
    {1729803600 7200 0 EET}
    {1743112800 10800 1 EEST}
    {1761858000 7200 0 EET}
    {1774562400 10800 1 EEST}
    {1793307600 7200 0 EET}
    {1806012000 10800 1 EEST}
    {1824757200 7200 0 EET}
    {1838066400 10800 1 EEST}
    {1856206800 7200 0 EET}
    {1869516000 10800 1 EEST}
    {1887656400 7200 0 EET}
    {1900965600 10800 1 EEST}
    {1919106000 7200 0 EET}
    {1932415200 10800 1 EEST}
    {1951160400 7200 0 EET}
    {1963864800 10800 1 EEST}
    {1982610000 7200 0 EET}
    {1995314400 10800 1 EEST}
    {2014059600 7200 0 EET}
    {2027368800 10800 1 EEST}
    {2045509200 7200 0 EET}
    {2058818400 10800 1 EEST}
    {2076958800 7200 0 EET}
    {2090268000 10800 1 EEST}
    {2109013200 7200 0 EET}
    {2121717600 10800 1 EEST}
    {2140462800 7200 0 EET}
    {2153167200 10800 1 EEST}
    {2171912400 7200 0 EET}
    {2184616800 10800 1 EEST}
    {2203362000 7200 0 EET}
    {2216671200 10800 1 EEST}
    {2234811600 7200 0 EET}
    {2248120800 10800 1 EEST}
    {2266261200 7200 0 EET}
    {2279570400 10800 1 EEST}
    {2298315600 7200 0 EET}
    {2311020000 10800 1 EEST}
    {2329765200 7200 0 EET}
    {2342469600 10800 1 EEST}
    {2361214800 7200 0 EET}
    {2374524000 10800 1 EEST}
    {2392664400 7200 0 EET}
    {2405973600 10800 1 EEST}
    {2424114000 7200 0 EET}
    {2437423200 10800 1 EEST}
    {2455563600 7200 0 EET}
    {2468872800 10800 1 EEST}
    {2487618000 7200 0 EET}
    {2500322400 10800 1 EEST}
    {2519067600 7200 0 EET}
    {2531772000 10800 1 EEST}
    {2550517200 7200 0 EET}
    {2563826400 10800 1 EEST}
    {2581966800 7200 0 EET}
    {2595276000 10800 1 EEST}
    {2613416400 7200 0 EET}
    {2626725600 10800 1 EEST}
    {2645470800 7200 0 EET}
    {2658175200 10800 1 EEST}
    {2676920400 7200 0 EET}
    {2689624800 10800 1 EEST}
    {2708370000 7200 0 EET}
    {2721679200 10800 1 EEST}
    {2739819600 7200 0 EET}
    {2753128800 10800 1 EEST}
    {2771269200 7200 0 EET}
    {2784578400 10800 1 EEST}
    {2802718800 7200 0 EET}
    {2816028000 10800 1 EEST}
    {2834773200 7200 0 EET}
    {2847477600 10800 1 EEST}
    {2866222800 7200 0 EET}
    {2878927200 10800 1 EEST}
    {2897672400 7200 0 EET}
    {2910981600 10800 1 EEST}
    {2929122000 7200 0 EET}
    {2942431200 10800 1 EEST}
    {2960571600 7200 0 EET}
    {2973880800 10800 1 EEST}
    {2992626000 7200 0 EET}
    {3005330400 10800 1 EEST}
    {3024075600 7200 0 EET}
    {3036780000 10800 1 EEST}
    {3055525200 7200 0 EET}
    {3068229600 10800 1 EEST}
    {3086974800 7200 0 EET}
    {3100284000 10800 1 EEST}
    {3118424400 7200 0 EET}
    {3131733600 10800 1 EEST}
    {3149874000 7200 0 EET}
    {3163183200 10800 1 EEST}
    {3181928400 7200 0 EET}
    {3194632800 10800 1 EEST}
    {3213378000 7200 0 EET}
    {3226082400 10800 1 EEST}
    {3244827600 7200 0 EET}
    {3258136800 10800 1 EEST}
    {3276277200 7200 0 EET}
    {3289586400 10800 1 EEST}
    {3307726800 7200 0 EET}
    {3321036000 10800 1 EEST}
    {3339176400 7200 0 EET}
    {3352485600 10800 1 EEST}
    {3371230800 7200 0 EET}
    {3383935200 10800 1 EEST}
    {3402680400 7200 0 EET}
    {3415384800 10800 1 EEST}
    {3434130000 7200 0 EET}
    {3447439200 10800 1 EEST}
    {3465579600 7200 0 EET}
    {3478888800 10800 1 EEST}
    {3497029200 7200 0 EET}
    {3510338400 10800 1 EEST}
    {3529083600 7200 0 EET}
    {3541788000 10800 1 EEST}
    {3560533200 7200 0 EET}
    {3573237600 10800 1 EEST}
    {3591982800 7200 0 EET}
    {3605292000 10800 1 EEST}
    {3623432400 7200 0 EET}
    {3636741600 10800 1 EEST}
    {3654882000 7200 0 EET}
    {3668191200 10800 1 EEST}
    {3686331600 7200 0 EET}
    {3699640800 10800 1 EEST}
    {3718386000 7200 0 EET}
    {3731090400 10800 1 EEST}
    {3749835600 7200 0 EET}
    {3762540000 10800 1 EEST}
    {3781285200 7200 0 EET}
    {3794594400 10800 1 EEST}
    {3812734800 7200 0 EET}
    {3826044000 10800 1 EEST}
    {3844184400 7200 0 EET}
    {3857493600 10800 1 EEST}
    {3876238800 7200 0 EET}
    {3888943200 10800 1 EEST}
    {3907688400 7200 0 EET}
    {3920392800 10800 1 EEST}
    {3939138000 7200 0 EET}
    {3951842400 10800 1 EEST}
    {3970587600 7200 0 EET}
    {3983896800 10800 1 EEST}
    {4002037200 7200 0 EET}
    {4015346400 10800 1 EEST}
    {4033486800 7200 0 EET}
    {4046796000 10800 1 EEST}
    {4065541200 7200 0 EET}
    {4078245600 10800 1 EEST}
    {4096990800 7200 0 EET}
}

Changes to library/tzdata/Asia/Gaza.

92
93
94
95
96
97
98


99
    {1219957200 7200 0 EET}
    {1238104800 10800 1 EEST}
    {1252018800 7200 0 EET}
    {1269640860 10800 1 EEST}
    {1281474000 7200 0 EET}
    {1301738460 10800 1 EEST}
    {1312146000 7200 0 EET}


}







>
>

92
93
94
95
96
97
98
99
100
101
    {1219957200 7200 0 EET}
    {1238104800 10800 1 EEST}
    {1252018800 7200 0 EET}
    {1269640860 10800 1 EEST}
    {1281474000 7200 0 EET}
    {1301738460 10800 1 EEST}
    {1312146000 7200 0 EET}
    {1333058400 10800 1 EEST}
    {1348779600 7200 0 EET}
}

Changes to library/tzdata/Asia/Hebron.

95
96
97
98
99
100
101


102
    {1252018800 7200 0 EET}
    {1269640860 10800 1 EEST}
    {1281474000 7200 0 EET}
    {1301652060 10800 1 EEST}
    {1312146000 7200 0 EET}
    {1314655200 10800 1 EEST}
    {1317340800 7200 0 EET}


}







>
>

95
96
97
98
99
100
101
102
103
104
    {1252018800 7200 0 EET}
    {1269640860 10800 1 EEST}
    {1281474000 7200 0 EET}
    {1301652060 10800 1 EEST}
    {1312146000 7200 0 EET}
    {1314655200 10800 1 EEST}
    {1317340800 7200 0 EET}
    {1333058400 10800 1 EEST}
    {1348790400 7200 0 EET}
}

Changes to library/tzdata/Asia/Yerevan.

62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
    {1224972000 14400 0 AMT}
    {1238277600 18000 1 AMST}
    {1256421600 14400 0 AMT}
    {1269727200 18000 1 AMST}
    {1288476000 14400 0 AMT}
    {1301176800 18000 1 AMST}
    {1319925600 14400 0 AMT}
    {1332626400 18000 1 AMST}
    {1351375200 14400 0 AMT}
    {1364680800 18000 1 AMST}
    {1382824800 14400 0 AMT}
    {1396130400 18000 1 AMST}
    {1414274400 14400 0 AMT}
    {1427580000 18000 1 AMST}
    {1445724000 14400 0 AMT}
    {1459029600 18000 1 AMST}
    {1477778400 14400 0 AMT}
    {1490479200 18000 1 AMST}
    {1509228000 14400 0 AMT}
    {1521928800 18000 1 AMST}
    {1540677600 14400 0 AMT}
    {1553983200 18000 1 AMST}
    {1572127200 14400 0 AMT}
    {1585432800 18000 1 AMST}
    {1603576800 14400 0 AMT}
    {1616882400 18000 1 AMST}
    {1635631200 14400 0 AMT}
    {1648332000 18000 1 AMST}
    {1667080800 14400 0 AMT}
    {1679781600 18000 1 AMST}
    {1698530400 14400 0 AMT}
    {1711836000 18000 1 AMST}
    {1729980000 14400 0 AMT}
    {1743285600 18000 1 AMST}
    {1761429600 14400 0 AMT}
    {1774735200 18000 1 AMST}
    {1792879200 14400 0 AMT}
    {1806184800 18000 1 AMST}
    {1824933600 14400 0 AMT}
    {1837634400 18000 1 AMST}
    {1856383200 14400 0 AMT}
    {1869084000 18000 1 AMST}
    {1887832800 14400 0 AMT}
    {1901138400 18000 1 AMST}
    {1919282400 14400 0 AMT}
    {1932588000 18000 1 AMST}
    {1950732000 14400 0 AMT}
    {1964037600 18000 1 AMST}
    {1982786400 14400 0 AMT}
    {1995487200 18000 1 AMST}
    {2014236000 14400 0 AMT}
    {2026936800 18000 1 AMST}
    {2045685600 14400 0 AMT}
    {2058386400 18000 1 AMST}
    {2077135200 14400 0 AMT}
    {2090440800 18000 1 AMST}
    {2108584800 14400 0 AMT}
    {2121890400 18000 1 AMST}
    {2140034400 14400 0 AMT}
    {2153340000 18000 1 AMST}
    {2172088800 14400 0 AMT}
    {2184789600 18000 1 AMST}
    {2203538400 14400 0 AMT}
    {2216239200 18000 1 AMST}
    {2234988000 14400 0 AMT}
    {2248293600 18000 1 AMST}
    {2266437600 14400 0 AMT}
    {2279743200 18000 1 AMST}
    {2297887200 14400 0 AMT}
    {2311192800 18000 1 AMST}
    {2329336800 14400 0 AMT}
    {2342642400 18000 1 AMST}
    {2361391200 14400 0 AMT}
    {2374092000 18000 1 AMST}
    {2392840800 14400 0 AMT}
    {2405541600 18000 1 AMST}
    {2424290400 14400 0 AMT}
    {2437596000 18000 1 AMST}
    {2455740000 14400 0 AMT}
    {2469045600 18000 1 AMST}
    {2487189600 14400 0 AMT}
    {2500495200 18000 1 AMST}
    {2519244000 14400 0 AMT}
    {2531944800 18000 1 AMST}
    {2550693600 14400 0 AMT}
    {2563394400 18000 1 AMST}
    {2582143200 14400 0 AMT}
    {2595448800 18000 1 AMST}
    {2613592800 14400 0 AMT}
    {2626898400 18000 1 AMST}
    {2645042400 14400 0 AMT}
    {2658348000 18000 1 AMST}
    {2676492000 14400 0 AMT}
    {2689797600 18000 1 AMST}
    {2708546400 14400 0 AMT}
    {2721247200 18000 1 AMST}
    {2739996000 14400 0 AMT}
    {2752696800 18000 1 AMST}
    {2771445600 14400 0 AMT}
    {2784751200 18000 1 AMST}
    {2802895200 14400 0 AMT}
    {2816200800 18000 1 AMST}
    {2834344800 14400 0 AMT}
    {2847650400 18000 1 AMST}
    {2866399200 14400 0 AMT}
    {2879100000 18000 1 AMST}
    {2897848800 14400 0 AMT}
    {2910549600 18000 1 AMST}
    {2929298400 14400 0 AMT}
    {2941999200 18000 1 AMST}
    {2960748000 14400 0 AMT}
    {2974053600 18000 1 AMST}
    {2992197600 14400 0 AMT}
    {3005503200 18000 1 AMST}
    {3023647200 14400 0 AMT}
    {3036952800 18000 1 AMST}
    {3055701600 14400 0 AMT}
    {3068402400 18000 1 AMST}
    {3087151200 14400 0 AMT}
    {3099852000 18000 1 AMST}
    {3118600800 14400 0 AMT}
    {3131906400 18000 1 AMST}
    {3150050400 14400 0 AMT}
    {3163356000 18000 1 AMST}
    {3181500000 14400 0 AMT}
    {3194805600 18000 1 AMST}
    {3212949600 14400 0 AMT}
    {3226255200 18000 1 AMST}
    {3245004000 14400 0 AMT}
    {3257704800 18000 1 AMST}
    {3276453600 14400 0 AMT}
    {3289154400 18000 1 AMST}
    {3307903200 14400 0 AMT}
    {3321208800 18000 1 AMST}
    {3339352800 14400 0 AMT}
    {3352658400 18000 1 AMST}
    {3370802400 14400 0 AMT}
    {3384108000 18000 1 AMST}
    {3402856800 14400 0 AMT}
    {3415557600 18000 1 AMST}
    {3434306400 14400 0 AMT}
    {3447007200 18000 1 AMST}
    {3465756000 14400 0 AMT}
    {3479061600 18000 1 AMST}
    {3497205600 14400 0 AMT}
    {3510511200 18000 1 AMST}
    {3528655200 14400 0 AMT}
    {3541960800 18000 1 AMST}
    {3560104800 14400 0 AMT}
    {3573410400 18000 1 AMST}
    {3592159200 14400 0 AMT}
    {3604860000 18000 1 AMST}
    {3623608800 14400 0 AMT}
    {3636309600 18000 1 AMST}
    {3655058400 14400 0 AMT}
    {3668364000 18000 1 AMST}
    {3686508000 14400 0 AMT}
    {3699813600 18000 1 AMST}
    {3717957600 14400 0 AMT}
    {3731263200 18000 1 AMST}
    {3750012000 14400 0 AMT}
    {3762712800 18000 1 AMST}
    {3781461600 14400 0 AMT}
    {3794162400 18000 1 AMST}
    {3812911200 14400 0 AMT}
    {3825612000 18000 1 AMST}
    {3844360800 14400 0 AMT}
    {3857666400 18000 1 AMST}
    {3875810400 14400 0 AMT}
    {3889116000 18000 1 AMST}
    {3907260000 14400 0 AMT}
    {3920565600 18000 1 AMST}
    {3939314400 14400 0 AMT}
    {3952015200 18000 1 AMST}
    {3970764000 14400 0 AMT}
    {3983464800 18000 1 AMST}
    {4002213600 14400 0 AMT}
    {4015519200 18000 1 AMST}
    {4033663200 14400 0 AMT}
    {4046968800 18000 1 AMST}
    {4065112800 14400 0 AMT}
    {4078418400 18000 1 AMST}
    {4096562400 14400 0 AMT}
}







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

62
63
64
65
66
67
68
69















































































































































































70
    {1224972000 14400 0 AMT}
    {1238277600 18000 1 AMST}
    {1256421600 14400 0 AMT}
    {1269727200 18000 1 AMST}
    {1288476000 14400 0 AMT}
    {1301176800 18000 1 AMST}
    {1319925600 14400 0 AMT}
    {1332626400 14400 0 AMT}















































































































































































}

Changes to library/tzdata/Atlantic/Stanley.

67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
    {1176613200 -14400 0 FKT}
    {1188712800 -10800 1 FKST}
    {1208667600 -14400 0 FKT}
    {1220767200 -10800 1 FKST}
    {1240117200 -14400 0 FKT}
    {1252216800 -10800 1 FKST}
    {1271566800 -14400 0 FKT}
    {1283666400 -10800 1 FKST}
    {1315112400 -10800 1 FKST}
    {1334466000 -14400 0 FKT}
    {1346565600 -10800 1 FKST}
    {1366520400 -14400 0 FKT}
    {1378015200 -10800 1 FKST}
    {1397970000 -14400 0 FKT}
    {1410069600 -10800 1 FKST}
    {1429419600 -14400 0 FKT}
    {1441519200 -10800 1 FKST}
    {1460869200 -14400 0 FKT}
    {1472968800 -10800 1 FKST}
    {1492318800 -14400 0 FKT}
    {1504418400 -10800 1 FKST}
    {1523768400 -14400 0 FKT}
    {1535868000 -10800 1 FKST}
    {1555822800 -14400 0 FKT}
    {1567317600 -10800 1 FKST}
    {1587272400 -14400 0 FKT}
    {1599372000 -10800 1 FKST}
    {1618722000 -14400 0 FKT}
    {1630821600 -10800 1 FKST}
    {1650171600 -14400 0 FKT}
    {1662271200 -10800 1 FKST}
    {1681621200 -14400 0 FKT}
    {1693720800 -10800 1 FKST}
    {1713675600 -14400 0 FKT}
    {1725170400 -10800 1 FKST}
    {1745125200 -14400 0 FKT}
    {1757224800 -10800 1 FKST}
    {1776574800 -14400 0 FKT}
    {1788674400 -10800 1 FKST}
    {1808024400 -14400 0 FKT}
    {1820124000 -10800 1 FKST}
    {1839474000 -14400 0 FKT}
    {1851573600 -10800 1 FKST}
    {1870923600 -14400 0 FKT}
    {1883023200 -10800 1 FKST}
    {1902978000 -14400 0 FKT}
    {1914472800 -10800 1 FKST}
    {1934427600 -14400 0 FKT}
    {1946527200 -10800 1 FKST}
    {1965877200 -14400 0 FKT}
    {1977976800 -10800 1 FKST}
    {1997326800 -14400 0 FKT}
    {2009426400 -10800 1 FKST}
    {2028776400 -14400 0 FKT}
    {2040876000 -10800 1 FKST}
    {2060226000 -14400 0 FKT}
    {2072325600 -10800 1 FKST}
    {2092280400 -14400 0 FKT}
    {2104380000 -10800 1 FKST}
    {2123730000 -14400 0 FKT}
    {2135829600 -10800 1 FKST}
    {2155179600 -14400 0 FKT}
    {2167279200 -10800 1 FKST}
    {2186629200 -14400 0 FKT}
    {2198728800 -10800 1 FKST}
    {2218078800 -14400 0 FKT}
    {2230178400 -10800 1 FKST}
    {2250133200 -14400 0 FKT}
    {2261628000 -10800 1 FKST}
    {2281582800 -14400 0 FKT}
    {2293682400 -10800 1 FKST}
    {2313032400 -14400 0 FKT}
    {2325132000 -10800 1 FKST}
    {2344482000 -14400 0 FKT}
    {2356581600 -10800 1 FKST}
    {2375931600 -14400 0 FKT}
    {2388031200 -10800 1 FKST}
    {2407381200 -14400 0 FKT}
    {2419480800 -10800 1 FKST}
    {2439435600 -14400 0 FKT}
    {2450930400 -10800 1 FKST}
    {2470885200 -14400 0 FKT}
    {2482984800 -10800 1 FKST}
    {2502334800 -14400 0 FKT}
    {2514434400 -10800 1 FKST}
    {2533784400 -14400 0 FKT}
    {2545884000 -10800 1 FKST}
    {2565234000 -14400 0 FKT}
    {2577333600 -10800 1 FKST}
    {2597288400 -14400 0 FKT}
    {2608783200 -10800 1 FKST}
    {2628738000 -14400 0 FKT}
    {2640837600 -10800 1 FKST}
    {2660187600 -14400 0 FKT}
    {2672287200 -10800 1 FKST}
    {2691637200 -14400 0 FKT}
    {2703736800 -10800 1 FKST}
    {2723086800 -14400 0 FKT}
    {2735186400 -10800 1 FKST}
    {2754536400 -14400 0 FKT}
    {2766636000 -10800 1 FKST}
    {2786590800 -14400 0 FKT}
    {2798085600 -10800 1 FKST}
    {2818040400 -14400 0 FKT}
    {2830140000 -10800 1 FKST}
    {2849490000 -14400 0 FKT}
    {2861589600 -10800 1 FKST}
    {2880939600 -14400 0 FKT}
    {2893039200 -10800 1 FKST}
    {2912389200 -14400 0 FKT}
    {2924488800 -10800 1 FKST}
    {2943838800 -14400 0 FKT}
    {2955938400 -10800 1 FKST}
    {2975893200 -14400 0 FKT}
    {2987992800 -10800 1 FKST}
    {3007342800 -14400 0 FKT}
    {3019442400 -10800 1 FKST}
    {3038792400 -14400 0 FKT}
    {3050892000 -10800 1 FKST}
    {3070242000 -14400 0 FKT}
    {3082341600 -10800 1 FKST}
    {3101691600 -14400 0 FKT}
    {3113791200 -10800 1 FKST}
    {3133746000 -14400 0 FKT}
    {3145240800 -10800 1 FKST}
    {3165195600 -14400 0 FKT}
    {3177295200 -10800 1 FKST}
    {3196645200 -14400 0 FKT}
    {3208744800 -10800 1 FKST}
    {3228094800 -14400 0 FKT}
    {3240194400 -10800 1 FKST}
    {3259544400 -14400 0 FKT}
    {3271644000 -10800 1 FKST}
    {3290994000 -14400 0 FKT}
    {3303093600 -10800 1 FKST}
    {3323048400 -14400 0 FKT}
    {3334543200 -10800 1 FKST}
    {3354498000 -14400 0 FKT}
    {3366597600 -10800 1 FKST}
    {3385947600 -14400 0 FKT}
    {3398047200 -10800 1 FKST}
    {3417397200 -14400 0 FKT}
    {3429496800 -10800 1 FKST}
    {3448846800 -14400 0 FKT}
    {3460946400 -10800 1 FKST}
    {3480901200 -14400 0 FKT}
    {3492396000 -10800 1 FKST}
    {3512350800 -14400 0 FKT}
    {3524450400 -10800 1 FKST}
    {3543800400 -14400 0 FKT}
    {3555900000 -10800 1 FKST}
    {3575250000 -14400 0 FKT}
    {3587349600 -10800 1 FKST}
    {3606699600 -14400 0 FKT}
    {3618799200 -10800 1 FKST}
    {3638149200 -14400 0 FKT}
    {3650248800 -10800 1 FKST}
    {3670203600 -14400 0 FKT}
    {3681698400 -10800 1 FKST}
    {3701653200 -14400 0 FKT}
    {3713752800 -10800 1 FKST}
    {3733102800 -14400 0 FKT}
    {3745202400 -10800 1 FKST}
    {3764552400 -14400 0 FKT}
    {3776652000 -10800 1 FKST}
    {3796002000 -14400 0 FKT}
    {3808101600 -10800 1 FKST}
    {3827451600 -14400 0 FKT}
    {3839551200 -10800 1 FKST}
    {3859506000 -14400 0 FKT}
    {3871605600 -10800 1 FKST}
    {3890955600 -14400 0 FKT}
    {3903055200 -10800 1 FKST}
    {3922405200 -14400 0 FKT}
    {3934504800 -10800 1 FKST}
    {3953854800 -14400 0 FKT}
    {3965954400 -10800 1 FKST}
    {3985304400 -14400 0 FKT}
    {3997404000 -10800 1 FKST}
    {4017358800 -14400 0 FKT}
    {4028853600 -10800 1 FKST}
    {4048808400 -14400 0 FKT}
    {4060908000 -10800 1 FKST}
    {4080258000 -14400 0 FKT}
    {4092357600 -10800 1 FKST}
}







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

67
68
69
70
71
72
73







































74










































































































































75
    {1176613200 -14400 0 FKT}
    {1188712800 -10800 1 FKST}
    {1208667600 -14400 0 FKT}
    {1220767200 -10800 1 FKST}
    {1240117200 -14400 0 FKT}
    {1252216800 -10800 1 FKST}
    {1271566800 -14400 0 FKT}







































    {1283662800 -10800 0 FKST}










































































































































}

Changes to library/tzdata/Pacific/Easter.

92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
    {1223784000 -18000 1 EASST}
    {1237086000 -21600 0 EAST}
    {1255233600 -18000 1 EASST}
    {1270350000 -21600 0 EAST}
    {1286683200 -18000 1 EASST}
    {1304823600 -21600 0 EAST}
    {1313899200 -18000 1 EASST}
    {1331434800 -21600 0 EAST}
    {1350187200 -18000 1 EASST}
    {1362884400 -21600 0 EAST}
    {1381636800 -18000 1 EASST}
    {1394334000 -21600 0 EAST}
    {1413086400 -18000 1 EASST}
    {1426388400 -21600 0 EAST}
    {1444536000 -18000 1 EASST}
    {1457838000 -21600 0 EAST}







|
|







92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
    {1223784000 -18000 1 EASST}
    {1237086000 -21600 0 EAST}
    {1255233600 -18000 1 EASST}
    {1270350000 -21600 0 EAST}
    {1286683200 -18000 1 EASST}
    {1304823600 -21600 0 EAST}
    {1313899200 -18000 1 EASST}
    {1335668400 -21600 0 EAST}
    {1346558400 -18000 1 EASST}
    {1362884400 -21600 0 EAST}
    {1381636800 -18000 1 EASST}
    {1394334000 -21600 0 EAST}
    {1413086400 -18000 1 EASST}
    {1426388400 -21600 0 EAST}
    {1444536000 -18000 1 EASST}
    {1457838000 -21600 0 EAST}

Changes to library/tzdata/Pacific/Fakaofo.

1
2
3
4
5

6
# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Fakaofo) {
    {-9223372036854775808 -41096 0 LMT}
    {-2177411704 -36000 0 TKT}

}





>

1
2
3
4
5
6
7
# created by tools/tclZIC.tcl - do not edit

set TZData(:Pacific/Fakaofo) {
    {-9223372036854775808 -41096 0 LMT}
    {-2177411704 -36000 0 TKT}
    {1325239200 50400 0 TKT}
}

Changes to tests/async.test.

13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

testConstraint testasync [llength [info commands testasync]]
testConstraint threaded [expr {
    [info exists ::tcl_platform(threaded)] && $::tcl_platform(threaded)
}]

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







|
<
<







13
14
15
16
17
18
19
20


21
22
23
24
25
26
27

if {[lsearch [namespace children] ::tcltest] == -1} {
    package require tcltest
    namespace import -force ::tcltest::*
}

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"
}

Changes to tests/coroutine.test.

553
554
555
556
557
558
559
560













561
562
563
564
565
566
567
568
569
570
571
572
573
574
575




576
577

578

579
580
581
582


583

584

585

586
587
588
589
590
591
592
593
594
595
596
} -result 0
test coroutine-6.3 {coroutine nargs} -body {
    coroutine a ::apply $lambda
    a a a
} -cleanup {
    rename a {}
} -returnCodes error -result {wrong # args: should be "a ?arg?"}
test coroutine-6.4 {unsupported: multi-argument yield} -body {













    proc corobody {} {
	set a 1
	while 1 {
	    set a [yield $a]
	    set a [::tcl::unsupported::yieldm $a]
	    lappend a [llength $a]
	}
    }
    coroutine a corobody
    coroutine b corobody
    list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
	[b ok] [rename b {}] 
} -cleanup {
    rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}





test coroutine-7.1 {yieldTo} -body {

    coroutine c apply {{} {

	yield
	tcl::unsupported::yieldTo return -level 0 -code 1 quux
	return quuy
    }}


    set res [list [catch c msg] $msg]

    lappend res [catch c msg] $msg

    lappend res [catch c msg] $msg

} -cleanup {
    unset res
} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]


# cleanup
unset lambda
::tcltest::cleanupTests

return








|
>
>
>
>
>
>
>
>
>
>
>
>
>




|










>
>
>
>
|
<
>
|
>
|
<
<
<
>
>
|
>
|
>
|
>

|
<
|







553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593

594
595
596
597



598
599
600
601
602
603
604
605
606
607

608
609
610
611
612
613
614
615
} -result 0
test coroutine-6.3 {coroutine nargs} -body {
    coroutine a ::apply $lambda
    a a a
} -cleanup {
    rename a {}
} -returnCodes error -result {wrong # args: should be "a ?arg?"}

test coroutine-7.1 {yieldto} -body {
    coroutine c apply {{} {
	yield
	yieldto return -level 0 -code 1 quux
	return quuy
    }}
    set res [list [catch c msg] $msg]
    lappend res [catch c msg] $msg
    lappend res [catch c msg] $msg
} -cleanup {
    unset res
} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]
test coroutine-7.2 {multi-argument yielding with yieldto} -body {
    proc corobody {} {
	set a 1
	while 1 {
	    set a [yield $a]
	    set a [yieldto return -level 0 $a]
	    lappend a [llength $a]
	}
    }
    coroutine a corobody
    coroutine b corobody
    list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \
	[b ok] [rename b {}] 
} -cleanup {
    rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
test coroutine-7.3 {yielding between coroutines} -body {
    proc juggler {target {value ""}} {
	if {$value eq ""} {
	    set value [yield [info coroutine]]
	}

	while {[llength $value]} {
	    lappend ::result $value [info coroutine]
	    set value [lrange $value 0 end-1]
	    lassign [yieldto $target $value] value



	}
	# Clear nested collection of coroutines
	catch $target
    }
    set result ""
    coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\
	{a b c d e}
    list $result [info command j1] [info command j2] [info command j3]
} -cleanup {
    catch {rename juggler ""}

} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}

# cleanup
unset lambda
::tcltest::cleanupTests

return

Changes to tests/dict.test.

1466
1467
1468
1469
1470
1471
1472



















































1473
1474
1475
1476
1477
1478
1479
    set ::d {p {q {a 1 b 2}}}
    apply {{} {
	dict with ::d p q {
	}
	return $a,$b
    }}
} 1,2




















































# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl







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







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
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
    set ::d {p {q {a 1 b 2}}}
    apply {{} {
	dict with ::d p q {
	}
	return $a,$b
    }}
} 1,2

proc linenumber {} {
    dict get [info frame -1] line
}
test dict-23.1 {dict compilation crash: Bug 3487626} {
    apply {n {
	set e {}
	set k {}
	dict for {a b} {c {d {e {f g}}}} {
	    ::tcl::dict::for {h i} $b {
		dict update i e j {
		    ::tcl::dict::update j f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]
} 5
test dict-23.2 {dict compilation crash: Bug 3487626} knownBug {
    # Something isn't quite right in line number and continuation line
    # tracking; at time of writing, this test produces 7, not 5, which
    # indicates that the extra newlines in the non-script argument are
    # confusing things.
    apply {n {
	set e {}
	set k {}
	dict for {a {
b
}} {c {d {e {f g}}}} {
	    ::tcl::dict::for {h {
i
}} ${
b
} {
		dict update {
i
} e {
j
} {
		    ::tcl::dict::update {
j
} f k {
			return [expr {$n - [linenumber]}]
		    }
		}
	    }
	}
    }} [linenumber]
} 5
rename linenumber {}

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl

Changes to tests/http.test.

551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617

test http-5.1 {http::formatQuery} {
    http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value%20two}
# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
    http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0d%0aline2%0d%0aline3}
test http-5.4 {http::formatQuery} {
    http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=~bwelch&name2=%c2%a1%c2%a2%c2%a2}
test http-5.5 {http::formatQuery} {
    set enc [http::config -urlencoding]
    http::config -urlencoding iso8859-1
    set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
    http::config -urlencoding $enc
    set res
} {name1=~bwelch&name2=%a1%a2%a2}

test http-6.1 {http::ProxyRequired} -body {
    http::config -proxyhost [info hostname] -proxyport $port
    set token [http::geturl $url]
    http::wait $token
    upvar #0 $token data
    set data(body)
} -cleanup {
    http::config -proxyhost {} -proxyport {}
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http:$url</h2>
</body></html>"

test http-7.1 {http::mapReply} {
    http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5b%5d%22%5c%28%29%7d%7b}
test http-7.2 {http::mapReply} {
    # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
    # so make sure this gets converted to utf-8 then urlencoded.
    http::mapReply "\u2208"
} {%e2%88%88}
test http-7.3 {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -returnCodes error -body {
    # this would be reverting to http <=2.4 behavior
    http::config -urlencoding ""
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result "can't read \"formMap(\u2208)\": no such element in array"
test http-7.4 {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -body {
    # this would be reverting to http <=2.4 behavior w/o errors
    # (unknown chars become '?')
    http::config -urlencoding "iso8859-1"
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result {%3f}

# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {







|


|






|

















|




|


















|







551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617

test http-5.1 {http::formatQuery} {
    http::formatQuery name1 value1 name2 "value two"
} {name1=value1&name2=value%20two}
# test http-5.2 obsoleted by 5.4 and 5.5 with http 2.5
test http-5.3 {http::formatQuery} {
    http::formatQuery lines "line1\nline2\nline3"
} {lines=line1%0D%0Aline2%0D%0Aline3}
test http-5.4 {http::formatQuery} {
    http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2
} {name1=~bwelch&name2=%C2%A1%C2%A2%C2%A2}
test http-5.5 {http::formatQuery} {
    set enc [http::config -urlencoding]
    http::config -urlencoding iso8859-1
    set res [http::formatQuery name1 ~bwelch name2 \xa1\xa2\xa2]
    http::config -urlencoding $enc
    set res
} {name1=~bwelch&name2=%A1%A2%A2}

test http-6.1 {http::ProxyRequired} -body {
    http::config -proxyhost [info hostname] -proxyport $port
    set token [http::geturl $url]
    http::wait $token
    upvar #0 $token data
    set data(body)
} -cleanup {
    http::config -proxyhost {} -proxyport {}
    http::cleanup $token
} -result "<html><head><title>HTTP/1.0 TEST</title></head><body>
<h1>Hello, World!</h1>
<h2>GET http:$url</h2>
</body></html>"

test http-7.1 {http::mapReply} {
    http::mapReply "abc\$\[\]\"\\()\}\{"
} {abc%24%5B%5D%22%5C%28%29%7D%7B}
test http-7.2 {http::mapReply} {
    # RFC 2718 specifies that we pass urlencoding on utf-8 chars by default,
    # so make sure this gets converted to utf-8 then urlencoded.
    http::mapReply "\u2208"
} {%E2%88%88}
test http-7.3 {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -returnCodes error -body {
    # this would be reverting to http <=2.4 behavior
    http::config -urlencoding ""
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result "can't read \"formMap(\u2208)\": no such element in array"
test http-7.4 {http::formatQuery} -setup {
    set enc [http::config -urlencoding]
} -body {
    # this would be reverting to http <=2.4 behavior w/o errors
    # (unknown chars become '?')
    http::config -urlencoding "iso8859-1"
    http::mapReply "\u2208"
} -cleanup {
    http::config -urlencoding $enc
} -result {%3F}

# cleanup
catch {unset url}
catch {unset badurl}
catch {unset port}
catch {unset data}
if {[info exists httpthread]} {

Changes to tests/oo.test.

127
128
129
130
131
132
133







134
135
136
137
138
139
140
\"oo::define oo::object method missingArgs\""
test oo-1.4 {basic test of OO functionality} -body {
    oo::object create {}
} -returnCodes 1 -result {object name must not be empty}
test oo-1.5 {basic test of OO functionality} -body {
    oo::object doesnotexist
} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}







test oo-1.6 {basic test of OO functionality} -setup {
    oo::object create aninstance
} -body {
    oo::objdefine aninstance unexport destroy
    aninstance doesnotexist
} -cleanup {
    rename aninstance {}







>
>
>
>
>
>
>







127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
\"oo::define oo::object method missingArgs\""
test oo-1.4 {basic test of OO functionality} -body {
    oo::object create {}
} -returnCodes 1 -result {object name must not be empty}
test oo-1.5 {basic test of OO functionality} -body {
    oo::object doesnotexist
} -returnCodes 1 -result {unknown method "doesnotexist": must be create, destroy or new}
test oo-1.5.1 {basic test of OO functionality} -setup {
    oo::object create aninstance
} -returnCodes error -body {
    aninstance
} -cleanup {
    rename aninstance {}
} -result {wrong # args: should be "aninstance method ?arg ...?"}
test oo-1.6 {basic test of OO functionality} -setup {
    oo::object create aninstance
} -body {
    oo::objdefine aninstance unexport destroy
    aninstance doesnotexist
} -cleanup {
    rename aninstance {}
326
327
328
329
330
331
332







































333
334
335
336
337
338
339
	constructor {} { tailcall my bar }
	method bar {}  { return bad }
    }
    namespace tail [foo create good]
} -cleanup {
    foo destroy
} -result good








































test oo-3.1 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as we're
    # modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO







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







333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
	constructor {} { tailcall my bar }
	method bar {}  { return bad }
    }
    namespace tail [foo create good]
} -cleanup {
    foo destroy
} -result good
test oo-2.7 {construction, method calls and ensembles - Bug 3514761} -setup {
    namespace eval k {}
} -body {
    namespace eval k {
	oo::class create s {
	    constructor {j} {
		# nothing
	    }
	}
	namespace export s
	namespace ensemble create
    }
    k s create X
} -returnCodes error -cleanup {
    namespace delete k
} -result {wrong # args: should be "k s create X j"}
test oo-2.8 {construction, method calls and ensembles - Bug 3514761} -setup {
    namespace eval k {}
} -body {
    namespace eval k {
	oo::class create s {
	    constructor {j} {
		# nothing
	    }
	}
	oo::class create t {
	    superclass s
	    constructor args {
		k next {*}$args
	    }
	}
	interp alias {} ::k::next {} ::oo::Helpers::next
	namespace export t next
	namespace ensemble create
    }
    k t create X
} -returnCodes error -cleanup {
    namespace delete k
} -result {wrong # args: should be "k next j"}

test oo-3.1 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as we're
    # modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO
1668
1669
1670
1671
1672
1673
1674


























































1675
1676
1677
1678
1679
1680
1681
	variable a b c
    }
    oo::copy Foo Bar
    info class variable Bar
} -cleanup {
    ArbitraryClass destroy
} -result {a b c}



























































test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}







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







1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
1783
1784
1785
	variable a b c
    }
    oo::copy Foo Bar
    info class variable Bar
} -cleanup {
    ArbitraryClass destroy
} -result {a b c}
test oo-15.6 {OO: object cloning copies namespace contents} -setup {
    oo::class create ArbitraryClass {export eval}
} -body {
    ArbitraryClass create a
    a eval {proc foo x {
	variable y
	return [string repeat $x [incr y]]
    }}
    set result [list [a eval {foo 2}] [a eval {foo 3}]]
    oo::copy a b
    a eval {rename foo bar}
    lappend result [b eval {foo 2}] [b eval {foo 3}] [a eval {bar 4}]
} -cleanup {
    ArbitraryClass destroy
} -result {2 33 222 3333 444}
test oo-15.7 {OO: classes can be cloned anonymously} -setup {
    oo::class create ArbitraryClassA
    oo::class create ArbitraryClassB {superclass ArbitraryClassA}
} -body {
    info object isa class [oo::copy ArbitraryClassB]
} -cleanup {
    ArbitraryClassA destroy
} -result 1
test oo-15.8 {OO: intercept object cloning} -setup {
    oo::class create Foo
    set result {}
} -body {
    oo::define Foo {
	constructor {msg} {
	    variable v $msg
	}
	method <cloned> {from} {
	    next $from
	    lappend ::result cloned $from [self]
	}
	method check {} {
	    variable v
	    lappend ::result check [self] $v
	}
    }
    Foo create foo ok
    oo::copy foo bar
    foo check
    bar check
} -cleanup {
    Foo destroy
} -result {cloned ::foo ::bar check ::foo ok check ::bar ok}
test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup {
    oo::class create Foo
} -body {
    oo::define Foo {
	method <cloned> {a b} {}
    }
    interp alias {} Bar {} oo::copy [Foo create foo]
    Bar bar
} -returnCodes error -cleanup {
    Foo destroy
} -result {wrong # args: should be "::bar <cloned> a b"}

test oo-16.1 {OO: object introspection} -body {
    info object
} -returnCodes 1 -result "wrong \# args: should be \"info object subcommand ?arg ...?\""
test oo-16.2 {OO: object introspection} -body {
    info object class NOTANOBJECT
} -returnCodes 1 -result {NOTANOBJECT does not refer to an object}
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
} -result {a b c}
test oo-16.11 {OO: object introspection} -setup {
    oo::class create foo
    foo create bar
} -body {
    oo::define foo method spong {} {...}
    oo::objdefine bar method boo {a {b c} args} {the body}
    list [info object methods bar -all] [info object methods bar -all -private]
} -cleanup {
    foo destroy
} -result {{boo destroy spong} {boo destroy eval spong unknown variable varname}}
test oo-16.12 {OO: object introspection} -setup {
    oo::object create foo
} -cleanup {
    rename foo {}
} -body {
    oo::objdefine foo unexport {*}[info object methods foo -all]
    info object methods foo -all







|


|







1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
} -result {a b c}
test oo-16.11 {OO: object introspection} -setup {
    oo::class create foo
    foo create bar
} -body {
    oo::define foo method spong {} {...}
    oo::objdefine bar method boo {a {b c} args} {the body}
    list [lsort [info object methods bar -all]] [lsort [info object methods bar -all -private]]
} -cleanup {
    foo destroy
} -result {{boo destroy spong} {<cloned> boo destroy eval spong unknown variable varname}}
test oo-16.12 {OO: object introspection} -setup {
    oo::object create foo
} -cleanup {
    rename foo {}
} -body {
    oo::objdefine foo unexport {*}[info object methods foo -all]
    info object methods foo -all
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
    oo::define foo {
	method bar {a {b c} args} {the body}
	self {
	    method bad {} {...}
	}
    }
    oo::define subfoo method boo {a {b c} args} {the body}
    list [info class methods subfoo -all] \
	[info class methods subfoo -all -private]
} -cleanup {
    foo destroy
} -result {{bar boo destroy} {bar boo destroy eval unknown variable varname}}
test oo-17.10 {OO: class introspection} -setup {
    oo::class create foo
} -cleanup {
    rename foo {}
} -body {
    oo::define foo unexport {*}[info class methods foo -all]
    info class methods foo -all







|
|


|







1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
    oo::define foo {
	method bar {a {b c} args} {the body}
	self {
	    method bad {} {...}
	}
    }
    oo::define subfoo method boo {a {b c} args} {the body}
    list [lsort [info class methods subfoo -all]] \
	[lsort [info class methods subfoo -all -private]]
} -cleanup {
    foo destroy
} -result {{bar boo destroy} {<cloned> bar boo destroy eval unknown variable varname}}
test oo-17.10 {OO: class introspection} -setup {
    oo::class create foo
} -cleanup {
    rename foo {}
} -body {
    oo::define foo unexport {*}[info class methods foo -all]
    info class methods foo -all
2385
2386
2387
2388
2389
2390
2391
2392
2393
2394
2395
2396
2397
2398
2399
	method level {} {
	    expr {[next] - [info frame]}
	}
    }
    list [i level] [i frames] [dict get [c frame] object]
} -cleanup {
    c destroy
} -result {1 {{type source line * file * cmd {info frame 0} method frames class ::c level 0} {type source line * file * cmd {info frame 0} method frames object ::i level 0}} ::c}
test oo-22.2 {OO and info frame: Bug 3001438} -setup {
    oo::class create c
} -body {
    oo::define c method test {{x 1}} {
	if {$x} {my test 0}
	lsort {q w e r t y u i o p}; # Overwrite the Tcl stack
	info frame 0







|







2489
2490
2491
2492
2493
2494
2495
2496
2497
2498
2499
2500
2501
2502
2503
	method level {} {
	    expr {[next] - [info frame]}
	}
    }
    list [i level] [i frames] [dict get [c frame] object]
} -cleanup {
    c destroy
} -result {1 {{* cmd {info frame 0} method frames class ::c level 0} {* cmd {info frame 0} method frames object ::i level 0}} ::c}
test oo-22.2 {OO and info frame: Bug 3001438} -setup {
    oo::class create c
} -body {
    oo::define c method test {{x 1}} {
	if {$x} {my test 0}
	lsort {q w e r t y u i o p}; # Overwrite the Tcl stack
	info frame 0
2456
2457
2458
2459
2460
2461
2462










2463
2464
2465
2466
2467
2468
2469
    cls create obj
    oo::objdefine obj {
	method dummy2 {} {}
	method unknown args {next {*}$args}
    }
    obj foo bar
} -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown}











# Probably need a better set of tests, but this is quite difficult to devise
test oo-25.1 {call chain caching} -setup {
    oo::class create cls {
	method ab {} {return ok}
    }
    set result {}







>
>
>
>
>
>
>
>
>
>







2560
2561
2562
2563
2564
2565
2566
2567
2568
2569
2570
2571
2572
2573
2574
2575
2576
2577
2578
2579
2580
2581
2582
2583
    cls create obj
    oo::objdefine obj {
	method dummy2 {} {}
	method unknown args {next {*}$args}
    }
    obj foo bar
} -result {unknown method "foo": must be destroy, dummy, dummy2 or unknown}
test oo-24.3 {unknown method method - absent method name} -setup {
    set o [oo::object new]
} -cleanup {
    $o destroy
} -body {
    oo::objdefine $o method unknown args {
	return "unknown: >>$args<<"
    }
    list [$o] [$o foobar] [$o foo bar]
} -result {{unknown: >><<} {unknown: >>foobar<<} {unknown: >>foo bar<<}}

# Probably need a better set of tests, but this is quite difficult to devise
test oo-25.1 {call chain caching} -setup {
    oo::class create cls {
	method ab {} {return ok}
    }
    set result {}
2747
2748
2749
2750
2751
2752
2753







































































































































































2754
2755
2756
2757
2758
2759
2760
	method get {} {return $x}
    }
    list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \
	[foo exists] [catch {foo get} msg] $msg
} -cleanup {
    foo destroy
} -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}}








































































































































































# A feature that's not supported because the mechanism may change without
# warning, but is supposed to work...
test oo-28.1 {scripted extensions to oo::define} -setup {
    interp create foo
    foo eval {oo::class create cls {export eval}}
} -cleanup {







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







2861
2862
2863
2864
2865
2866
2867
2868
2869
2870
2871
2872
2873
2874
2875
2876
2877
2878
2879
2880
2881
2882
2883
2884
2885
2886
2887
2888
2889
2890
2891
2892
2893
2894
2895
2896
2897
2898
2899
2900
2901
2902
2903
2904
2905
2906
2907
2908
2909
2910
2911
2912
2913
2914
2915
2916
2917
2918
2919
2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
2942
2943
2944
2945
2946
2947
2948
2949
2950
2951
2952
2953
2954
2955
2956
2957
2958
2959
2960
2961
2962
2963
2964
2965
2966
2967
2968
2969
2970
2971
2972
2973
2974
2975
2976
2977
2978
2979
2980
2981
2982
2983
2984
2985
2986
2987
2988
2989
2990
2991
2992
2993
2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
3015
3016
3017
3018
3019
3020
3021
3022
3023
3024
3025
3026
3027
3028
3029
3030
3031
3032
3033
3034
3035
3036
3037
3038
3039
3040
3041
	method get {} {return $x}
    }
    list [foo exists] [foo set 7] [foo exists] [foo get] [foo unset] \
	[foo exists] [catch {foo get} msg] $msg
} -cleanup {
    foo destroy
} -result {0 7 1 7 {} 0 1 {can't read "x": no such variable}}
test oo-27.14 {variables declaration - multiple use} -setup {
    oo::class create master
} -cleanup {
    master destroy
} -body {
    oo::class create foo {
	superclass master
	variable x
	variable y
	method boo {} {
	    return [incr x],[incr y]
	}
    }
    foo create bar
    list [bar boo] [bar boo]
} -result {1,1 2,2}
test oo-27.15 {variables declaration - multiple use} -setup {
    oo::class create master
} -cleanup {
    master destroy
} -body {
    oo::class create foo {
	superclass master
	variable
	variable x y
	method boo {} {
	    return [incr x],[incr y]
	}
    }
    foo create bar
    list [bar boo] [bar boo]
} -result {1,1 2,2}
test oo-27.16 {variables declaration - multiple use} -setup {
    oo::class create master
} -cleanup {
    master destroy
} -body {
    oo::class create foo {
	superclass master
	variable x
	variable -clear
	variable y
	method boo {} {
	    return [incr x],[incr y]
	}
    }
    foo create bar
    list [bar boo] [bar boo]
} -result {1,1 1,2}
test oo-27.17 {variables declaration - multiple use} -setup {
    oo::class create master
} -cleanup {
    master destroy
} -body {
    oo::class create foo {
	superclass master
	variable x
	variable -set y
	method boo {} {
	    return [incr x],[incr y]
	}
    }
    foo create bar
    list [bar boo] [bar boo]
} -result {1,1 1,2}
test oo-27.18 {variables declaration - multiple use} -setup {
    oo::class create master
} -cleanup {
    master destroy
} -body {
    oo::class create foo {
	superclass master
	variable x
	variable -? y
	method boo {} {
	    return [incr x],[incr y]
	}
    }
    foo create bar
    list [bar boo] [bar boo]
} -returnCodes error -match glob -result {unknown method "-?": must be *}
test oo-27.19 {variables declaration and [info vars]: Bug 2712377} -setup {
    oo::class create Foo
    set result {}
} -body {
    # This is really a test of problems to do with Tcl's introspection when a
    # variable resolver is present...
    oo::define Foo {
	variable foo bar
	method setvars {f b} {
	    set foo $f
	    set bar $b
	}
	method dump1 {} {
	    lappend ::result <1>
	    foreach v [lsort [info vars *]] {
		lappend ::result $v=[set $v]
	    }
	    lappend ::result [info locals] [info locals *]
	}
	method dump2 {} {
	    lappend ::result <2>
	    foreach v [lsort [info vars *]] {
		lappend ::result $v=[set $v]
	    }
	    lappend ::result | foo=$foo [info locals] [info locals *]
	}
    }
    Foo create stuff
    stuff setvars what ever
    stuff dump1
    stuff dump2
    return $result
} -cleanup {
    Foo destroy
} -result {<1> bar=ever foo=what v v <2> bar=ever foo=what | foo=what v v}
test oo-27.20 {variables declaration and [info vars]: Bug 2712377} -setup {
    oo::class create Foo
    set result {}
} -body {
    # This is really a test of problems to do with Tcl's introspection when a
    # variable resolver is present...
    oo::define Foo {
	variable foo bar
	method setvars {f b} {
	    set foo $f
	    set bar $b
	}
	method dump1 {} {
	    lappend ::result <1>
	    foreach v [lsort [info vars *o]] {
		lappend ::result $v=[set $v]
	    }
	    lappend ::result [info locals] [info locals *]
	}
	method dump2 {} {
	    lappend ::result <2>
	    foreach v [lsort [info vars *o]] {
		lappend ::result $v=[set $v]
	    }
	    lappend ::result | foo=$foo [info locals] [info locals *]
	}
    }
    Foo create stuff
    stuff setvars what ever
    stuff dump1
    stuff dump2
    return $result
} -cleanup {
    Foo destroy
} -result {<1> foo=what v v <2> foo=what | foo=what v v}
test oo-27.21 {variables declaration uniqueifies: Bug 3396896} -setup {
    oo::class create Foo
} -body {
    oo::define Foo variable v v v t t v t
    info class variable Foo
} -cleanup {
    Foo destroy
} -result {v t}
test oo-27.22 {variables declaration uniqueifies: Bug 3396896} -setup {
    oo::object create foo
} -body {
    oo::objdefine foo variable v v v t t v t
    info object variable foo
} -cleanup {
    foo destroy
} -result {v t}

# A feature that's not supported because the mechanism may change without
# warning, but is supposed to work...
test oo-28.1 {scripted extensions to oo::define} -setup {
    interp create foo
    foo eval {oo::class create cls {export eval}}
} -cleanup {
2828
2829
2830
2831
2832
2833
2834
2835














































































































































2836
2837
2838
2839
2840
2841
	    rename coro {}
	}
    }
    list [leaktest {[cls new] destroy}] [info class instances cls]
} -cleanup {
    cls destroy
} -result {0 {}}















































































































































cleanupTests
return

# Local Variables:
# mode: tcl
# End:







|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>






3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
	    rename coro {}
	}
    }
    list [leaktest {[cls new] destroy}] [info class instances cls]
} -cleanup {
    cls destroy
} -result {0 {}}

oo::class create SampleSlot {
    superclass oo::Slot
    constructor {} {
	variable contents {a b c} ops {}
    }
    method contents {} {variable contents; return $contents}
    method ops {} {variable ops; return $ops}
    method Get {} {
	variable contents
	variable ops
	lappend ops [info level] Get
	return $contents
    }
    method Set {lst} {
	variable contents $lst
	variable ops
	lappend ops [info level] Set $lst
	return
    }
}

test oo-32.1 {TIP 380: slots - class test} -setup {
    SampleSlot create sampleSlot
} -body {
    list [info level] [sampleSlot contents] [sampleSlot ops]
} -cleanup {
    rename sampleSlot {}
} -result {0 {a b c} {}}
test oo-32.2 {TIP 380: slots - class test} -setup {
    SampleSlot create sampleSlot
} -body {
    list [info level] [sampleSlot -clear] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
    rename sampleSlot {}
} -result {0 {} {} {1 Set {}}}
test oo-32.3 {TIP 380: slots - class test} -setup {
    SampleSlot create sampleSlot
} -body {
    list [info level] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
    rename sampleSlot {}
} -result {0 {} {a b c g h i} {1 Get 1 Set {a b c g h i}}}
test oo-32.4 {TIP 380: slots - class test} -setup {
    SampleSlot create sampleSlot
} -body {
    list [info level] [sampleSlot -set d e f] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
    rename sampleSlot {}
} -result {0 {} {d e f} {1 Set {d e f}}}
test oo-32.5 {TIP 380: slots - class test} -setup {
    SampleSlot create sampleSlot
} -body {
    list [info level] [sampleSlot -set d e f] [sampleSlot -append g h i] \
	[sampleSlot contents] [sampleSlot ops]
} -cleanup {
    rename sampleSlot {}
} -result {0 {} {} {d e f g h i} {1 Set {d e f} 1 Get 1 Set {d e f g h i}}}

test oo-33.1 {TIP 380: slots - defaulting} -setup {
    set s [SampleSlot new]
} -body {
    list [$s x y] [$s contents]
} -cleanup {
    rename $s {}
} -result {{} {a b c x y}}
test oo-33.2 {TIP 380: slots - defaulting} -setup {
    set s [SampleSlot new]
} -body {
    list [$s destroy; $s unknown] [$s contents]
} -cleanup {
    rename $s {}
} -result {{} {a b c destroy unknown}}
test oo-32.3 {TIP 380: slots - defaulting} -setup {
    set s [SampleSlot new]
} -body {
    oo::objdefine $s forward --default-operation  my -set
    list [$s destroy; $s unknown] [$s contents] [$s ops]
} -cleanup {
    rename $s {}
} -result {{} unknown {1 Set destroy 1 Set unknown}}
test oo-33.4 {TIP 380: slots - errors} -setup {
    set s [SampleSlot new]
} -body {
    # Method names beginning with "-" are special to slots
    $s -grill q
} -returnCodes error -cleanup {
    rename $s {}
} -result {unknown method "-grill": must be -append, -clear, -set, contents or ops}

SampleSlot destroy

test oo-34.1 {TIP 380: slots - presence} -setup {
    set obj [oo::object new]
    set result {}
} -body {
    oo::define oo::object {
	::lappend ::result [::info object class filter]
	::lappend ::result [::info object class mixin]
	::lappend ::result [::info object class superclass]
	::lappend ::result [::info object class variable]
    }
    oo::objdefine $obj {
	::lappend ::result [::info object class filter]
	::lappend ::result [::info object class mixin]
	::lappend ::result [::info object class variable]
    }
    return $result
} -cleanup {
    $obj destroy
} -result {::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot ::oo::Slot}
test oo-34.2 {TIP 380: slots - presence} {
    lsort [info class instances oo::Slot]
} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable}
proc getMethods obj {
    list [lsort [info object methods $obj -all]] \
	[lsort [info object methods $obj -private]]
}
test oo-34.3 {TIP 380: slots - presence} {
    getMethods oo::define::filter
} {{-append -clear -set} {Get Set}}
test oo-34.4 {TIP 380: slots - presence} {
    getMethods oo::define::mixin
} {{-append -clear -set} {--default-operation Get Set}}
test oo-34.5 {TIP 380: slots - presence} {
    getMethods oo::define::superclass
} {{-append -clear -set} {--default-operation Get Set}}
test oo-34.6 {TIP 380: slots - presence} {
    getMethods oo::define::variable
} {{-append -clear -set} {Get Set}}
test oo-34.7 {TIP 380: slots - presence} {
    getMethods oo::objdefine::filter
} {{-append -clear -set} {Get Set}}
test oo-34.8 {TIP 380: slots - presence} {
    getMethods oo::objdefine::mixin
} {{-append -clear -set} {--default-operation Get Set}}
test oo-34.9 {TIP 380: slots - presence} {
    getMethods oo::objdefine::variable
} {{-append -clear -set} {Get Set}}

cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/reg.test.

169
170
171
172
173
174
175




















176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
	foreach f [split $infonameorder ""] {
	    if {[string match *$f* $fl]} {
		lappend ret $infonames($f)
	    }
	}
	return $ret
    }





















    # match expected, internal routine that does the work
    # parameters like the "real" routines except they don't have "opts",
    #  which is a possibly-empty list of switches for the regexp match attempt
    # The ! flag is used to indicate expected match failure (for REG_EXPECT,
    #  which wants argument testing even in the event of failure).
    proc MatchExpected {opts testid flags re target args} {
	variable regBug

	# if &, test as both BRE and ARE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [list testregexp]

	if {$regBug} {
	    # This will register as a skipped test
	    lappend constraints knownBug
	}

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will register as a skipped test
	    lappend constraints localeRegexp
	}

	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about        {*}$f $re]
	set ecmd [list testregexp {*}$opts {*}$f $re $target]

	set nsub [expr {[llength $args] - 1}]







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







<
<








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







169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202


203
204
205
206
207
208
209
210
211











212
213
214
215
216
217
218
	foreach f [split $infonameorder ""] {
	    if {[string match *$f* $fl]} {
		lappend ret $infonames($f)
	    }
	}
	return $ret
    }

    # Share the generation of the list of test constraints so it is
    # done the same on all routes.
    proc TestConstraints {flags} {
	set constraints [list testregexp]

	variable regBug
	if {$regBug} {
	    # This will trigger registration as a skipped test
	    lappend constraints knownBug
	}

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will trigger registration as a skipped test
	    lappend constraints localeRegexp
	}

	return $constraints
    }

    # match expected, internal routine that does the work
    # parameters like the "real" routines except they don't have "opts",
    #  which is a possibly-empty list of switches for the regexp match attempt
    # The ! flag is used to indicate expected match failure (for REG_EXPECT,
    #  which wants argument testing even in the event of failure).
    proc MatchExpected {opts testid flags re target args} {


	# if &, test as both BRE and ARE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    MatchExpected $opts "$testid ARE" ${f}  $re $target {*}$args
	    MatchExpected $opts "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [TestConstraints $flags]












	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about        {*}$f $re]
	set ecmd [list testregexp {*}$opts {*}$f $re $target]

	set nsub [expr {[llength $args] - 1}]
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270

271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectError "$testid ARE" ${f}  $re $err
	    expectError "$testid BRE" ${f}b $re $err
	    return
	}

	set constraints [list testregexp]

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will register as a skipped test
	    lappend constraints localeRegexp
	}

	set cmd [list testregexp -about {*}[TestFlags $flags] $re]
	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
		-constraints $constraints -result [list 1 REG_$err] -body \
		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
    }

    # match failure expected
    proc expectNomatch {testid flags re target args} {

	# if &, test as both ARE and BRE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [list testregexp]

	# Tcl locale stuff doesn't do the ch/xy test fakery yet
	if {[string match *+* $flags]} {
	    # This will register as a skipped test
	    lappend constraints localeRegexp
	}

	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about {*}$f $re]
	set nsub [expr {[llength $args] - 1}]
	if {$nsub == -1} {
	    # didn't tell us number of subexps







|
<
<
<
<
<
<









>








|
<
<
<
<
<
<







255
256
257
258
259
260
261
262






263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281






282
283
284
285
286
287
288
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectError "$testid ARE" ${f}  $re $err
	    expectError "$testid BRE" ${f}b $re $err
	    return
	}

	set constraints [TestConstraints $flags]







	set cmd [list testregexp -about {*}[TestFlags $flags] $re]
	::tcltest::test [TestNum $testid error] [TestDesc $testid error] \
		-constraints $constraints -result [list 1 REG_$err] -body \
		"list \[catch \{$cmd\}\] \[lindex \$::errorCode 1\]"
    }

    # match failure expected
    proc expectNomatch {testid flags re target args} {
	variable regBug
	# if &, test as both ARE and BRE
	if {[string match *&* $flags]} {
	    set f [string map {& {}} $flags]
	    expectNomatch "$testid ARE" ${f}  $re $target {*}$args
	    expectNomatch "$testid BRE" ${f}b $re $target {*}$args
	    return
	}

	set constraints [TestConstraints $flags]







	set f [TestFlags $flags]
	set infoflags [TestInfoFlags $flags]
	set ccmd [list testregexp -about {*}$f $re]
	set nsub [expr {[llength $args] - 1}]
	if {$nsub == -1} {
	    # didn't tell us number of subexps
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
    proc knownBug {args} {
	variable regBug 1
	uplevel \#0 $args
	set regBug 0
    }
}
namespace import RETest::*

######## the tests themselves ########

# support functions and preliminary misc.
# This is sensitive to changes in message wording, but we really have to
# test the code->message expansion at least once.
::tcltest::test reg-0.1 "regexp error reporting" {
    list [catch {regexp (*) ign} msg] $msg







|







323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
    proc knownBug {args} {
	variable regBug 1
	uplevel \#0 $args
	set regBug 0
    }
}
namespace import RETest::*

######## the tests themselves ########

# support functions and preliminary misc.
# This is sensitive to changes in message wording, but we really have to
# test the code->message expansion at least once.
::tcltest::test reg-0.1 "regexp error reporting" {
    list [catch {regexp (*) ign} msg] $msg
664
665
666
667
668
669
670



671
672
673
674
675
676
677
expectNomatch	14.14 QRP	"a(\[bc])\\1{3,4}"	abbb
expectMatch	14.15 RP	{a([bc])\1*}	abbb	abbb	b
expectMatch	14.16 RP	{a([bc])\1*}	ab	ab	b
expectMatch	14.17 RP	{a([bc])(\1*)}	ab	ab	b	""
expectError	14.18 -		{a((b)\1)}	ESUBREG
expectError	14.19 -		{a(b)c\2}	ESUBREG
expectMatch	14.20 bR	{a\(b*\)c\1}	abbcbb	abbcbb	bb





doing 15 "octal escapes vs back references"
# initial zero is always octal
expectMatch	15.1  MP	"a\\010b"	"a\bb"	"a\bb"
expectMatch	15.2  MP	"a\\0070b"	"a\0070b"	"a\0070b"
expectMatch	15.3  MP	"a\\07b"	"a\007b"	"a\007b"







>
>
>







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
expectNomatch	14.14 QRP	"a(\[bc])\\1{3,4}"	abbb
expectMatch	14.15 RP	{a([bc])\1*}	abbb	abbb	b
expectMatch	14.16 RP	{a([bc])\1*}	ab	ab	b
expectMatch	14.17 RP	{a([bc])(\1*)}	ab	ab	b	""
expectError	14.18 -		{a((b)\1)}	ESUBREG
expectError	14.19 -		{a(b)c\2}	ESUBREG
expectMatch	14.20 bR	{a\(b*\)c\1}	abbcbb	abbcbb	bb
expectMatch	14.21 RP	{^([bc])\1*$}	bbb	bbb	b
expectMatch	14.22 RP	{^([bc])\1*$}	ccc	ccc	c
knownBug expectNomatch 14.23 R	{^([bc])\1*$}	bcb


doing 15 "octal escapes vs back references"
# initial zero is always octal
expectMatch	15.1  MP	"a\\010b"	"a\bb"	"a\bb"
expectMatch	15.2  MP	"a\\0070b"	"a\0070b"	"a\0070b"
expectMatch	15.3  MP	"a\\07b"	"a\007b"	"a\007b"
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084




test reg-33.13 {Bug 1810264 - infinite loop} {
    regexp {($|^)*} {x}
} 1
# Some environments have small default stack sizes. [Bug 1905562]
test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable {
    regexp {(x{200}){200}$y} {x}
} 0

# cleanup
::tcltest::cleanupTests
return











|



>
>
>
>
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
test reg-33.13 {Bug 1810264 - infinite loop} {
    regexp {($|^)*} {x}
} 1
# Some environments have small default stack sizes. [Bug 1905562]
test reg-33.14 {Bug 1810264 - super-expensive expression} nonPortable {
    regexp {(x{200}){200}$y} {x}
} 0

# cleanup
::tcltest::cleanupTests
return

# Local Variables:
# mode: tcl
# End:

Changes to tests/source.test.

103
104
105
106
107
108
109













110
111
112
113
114
115
116
    set sourcefile [makeFile {} _non_existent_]
    removeFile _non_existent_
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorCode
} -match listGlob -result [list 1 \
	{couldn't read file "*_non_existent_": no such file or directory} \
	{POSIX ENOENT {no such file or directory}}]














test source-3.1 {return in middle of source file} -setup {
    set sourcefile [makeFile {
	set x new-x
	return allDone
	set y new-y
    } source.file]







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







103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
    set sourcefile [makeFile {} _non_existent_]
    removeFile _non_existent_
} -body {
    list [catch {source $sourcefile} msg] $msg $::errorCode
} -match listGlob -result [list 1 \
	{couldn't read file "*_non_existent_": no such file or directory} \
	{POSIX ENOENT {no such file or directory}}]
test source-2.7 {utf-8 with BOM} -setup {
    set sourcefile [makeFile {} source.file]
} -body {
    set out [open $sourcefile w]
    fconfigure $out -encoding utf-8
    puts $out "\ufeffset y new-y"
    close $out
    set y old-y
    source -encoding utf-8 $sourcefile
    return $y
} -cleanup {
    removeFile $sourcefile
} -result {new-y}

test source-3.1 {return in middle of source file} -setup {
    set sourcefile [makeFile {
	set x new-x
	return allDone
	set y new-y
    } source.file]

Changes to tests/string.test.

308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
    list [catch {string is alpha -failin str} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4 {string is, too many args} {
    list [catch {string is alpha -failin var -strict str more} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5 {string is, class check} {
    list [catch {string is bogus str} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6 {string is, ambiguous class} {
    list [catch {string is al str} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7 {string is alpha, all ok} {
    string is alpha -strict -failindex var abc
} 1
test string-6.8 {string is, error in var} {
    list [string is alpha -failindex var abc5def] $var
} {0 3}
test string-6.9 {string is, var shouldn't get set} {







|


|







308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
    list [catch {string is alpha -failin str} msg] $msg
} {1 {wrong # args: should be "string is alpha ?-strict? ?-failindex var? str"}}
test string-6.4 {string is, too many args} {
    list [catch {string is alpha -failin var -strict str more} msg] $msg
} {1 {wrong # args: should be "string is class ?-strict? ?-failindex var? str"}}
test string-6.5 {string is, class check} {
    list [catch {string is bogus str} msg] $msg
} {1 {bad class "bogus": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.6 {string is, ambiguous class} {
    list [catch {string is al str} msg] $msg
} {1 {ambiguous class "al": must be alnum, alpha, ascii, control, boolean, digit, double, entier, false, graph, integer, list, lower, print, punct, space, true, upper, wideinteger, wordchar, or xdigit}}
test string-6.7 {string is alpha, all ok} {
    string is alpha -strict -failindex var abc
} 1
test string-6.8 {string is, error in var} {
    list [string is alpha -failindex var abc5def] $var
} {0 3}
test string-6.9 {string is, var shouldn't get set} {
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
test string-6.90 {string is integer, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is int -strict $num]
    }
    set result
} {1 1 0 0 0 1 0 0}
test string-6.91 {string is double, bad doubles} {
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [string is double -strict $num]
    }
    set result
} {1 1 0 0 0 1 0 0}
test string-6.92 {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [string is integer -failindex var $x] $var
} {0 -1}
test string-6.93 {string is integer, 32-bit overflow} {







|







|







588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
test string-6.90 {string is integer, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is int -strict $num]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.91 {string is double, bad doubles} {
    set result ""
    set numbers [list 1.0 +1.0 ++1.0 +-1.0 -+1.0 -1.0 --1.0 "- +1.0"]
    foreach num $numbers {
	lappend result [string is double -strict $num]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.92 {string is integer, 32-bit overflow} {
    # Bug 718878
    set x 0x100000000
    list [string is integer -failindex var $x] $var
} {0 -1}
test string-6.93 {string is integer, 32-bit overflow} {
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676








































































677
678
679
680
681
682
683
test string-6.107 {string is integer, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is wideinteger -strict $num]
    }
    set result
} {1 1 0 0 0 1 0 0}
test string-6.108 {string is double, Bug 1382287} {
    set x 2turtledoves
    string is double $x
    string is double $x
} 0
test string-6.109 {string is double, Bug 1360532} {
    string is double 1\u00a0
} 0









































































catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.2 {string last, bad args} {







|









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







660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
test string-6.107 {string is integer, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is wideinteger -strict $num]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.108 {string is double, Bug 1382287} {
    set x 2turtledoves
    string is double $x
    string is double $x
} 0
test string-6.109 {string is double, Bug 1360532} {
    string is double 1\u00a0
} 0
test string-6.110 {string is entier, true} {
    string is entier +1234567890
} 1
test string-6.111 {string is entier, true on type} {
    string is entier [expr wide(50.0)]
} 1
test string-6.112 {string is entier, true} {
    string is entier [list -10]
} 1
test string-6.113 {string is entier, true as hex} {
    string is entier 0xabcdef
} 1
test string-6.114 {string is entier, true as octal} {
    string is entier 0123456
} 1
test string-6.115 {string is entier, true with whitespace} {
    string is entier "  \n1234\v"
} 1
test string-6.116 {string is entier, false} {
    list [string is entier -fail var 123abc] $var
} {0 3}
test string-6.117 {string is entier, false} {
    list [string is entier -fail var 123123123123123123123123123123123123123123123123123123123123123123123123123123123123abc] $var
} {0 84}
test string-6.118 {string is entier, false} {
    list [string is entier -fail var [expr double(1)]] $var
} {0 1}
test string-6.119 {string is entier, false} {
    list [string is entier -fail var "    "] $var
} {0 0}
test string-6.120 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o36963] $var
} {0 4}
test string-6.121.1 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o36963] $var
} {0 4}
test string-6.122 {string is entier, false on bad hex} {
    list [string is entier -fail var 0X345XYZ] $var
} {0 5}
test string-6.123 {string is entier, bad integers} {
    # SF bug #634856
    set result ""
    set numbers [list 1 +1 ++1 +-1 -+1 -1 --1 "- +1"]
    foreach num $numbers {
	lappend result [string is entier -strict $num]
    }
    return $result
} {1 1 0 0 0 1 0 0}
test string-6.124 {string is entier, true} {
    string is entier +1234567890123456789012345678901234567890
} 1
test string-6.125 {string is entier, true} {
    string is entier [list -10000000000000000000000000000000000000000000000000000000000000000000000000000000000000]
} 1
test string-6.126 {string is entier, true as hex} {
    string is entier 0xabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdefabcdef
} 1
test string-6.127 {string is entier, true as octal} {
    string is entier 0123456112341234561234565623456123456123456123456123456123456123456123456123456123456
} 1
test string-6.128 {string is entier, true with whitespace} {
    string is entier "  \n12340000000000000000000000000000000000000000000000000000000000000000000000000000000000000\v"
} 1
test string-6.129 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
} {0 87}
test string-6.130.1 {string is entier, false on bad octal} {
    list [string is entier -fail var 0o1234561123412345612345656234561234561234561234561234561234561234561234561234561234536963] $var
} {0 87}
test string-6.131 {string is entier, false on bad hex} {
    list [string is entier -fail var 0X12345611234123456123456562345612345612345612345612345612345612345612345612345612345345XYZ] $var
} {0 88}

catch {rename largest_int {}}

test string-7.1 {string last, too few args} {
    list [catch {string last a} msg] $msg
} {1 {wrong # args: should be "string last needleString haystackString ?startIndex?"}}
test string-7.2 {string last, bad args} {

Changes to tests/trace.test.

2554
2555
2556
2557
2558
2559
2560







2561





2562

















































2563
2564
2565
2566
2567
2568
2569
    } -body {
	untraced $t
	list \$::tracevar \$::tracevar2
    } -result {$r}
}
runbase {{- *} {-* *} {- *} {- *}} $base
































































# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}
catch {rename untraced {}}
catch {rename traceproc {}}







>
>
>
>
>
>
>
|
>
>
>
>
>
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







2554
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
2590
2591
2592
2593
2594
2595
2596
2597
2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
2620
2621
2622
2623
2624
2625
2626
2627
2628
2629
2630
    } -body {
	untraced $t
	list \$::tracevar \$::tracevar2
    } -result {$r}
}
runbase {{- *} {-* *} {- *} {- *}} $base

test trace-39 {bug #3484621: tracing Bc'ed commands} -setup {
    set ::traceLog 0
    set ::traceCalls 0
    set ::bar [list 0 1 2 3]
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
    proc foo {} {
	incr ::traceCalls
	# choose a BC'ed command that is 'unlikely' to interfere with tcltest's
	# internals 
	lset ::bar 1 2
    }
} -body {
    foo
    lappend res $::traceLog

    trace add execution lset enter dotrace
    foo
    lappend res $::traceLog

    trace remove execution lset enter dotrace
    foo
    lappend res $::traceLog

    list $::traceCalls | {*}$res
} -cleanup {
    unset ::traceLog ::traceCalls ::bar res
    rename dotrace {}
    rename foo {}
} -result {3 | 0 1 1}
    
test trace-39.1 {bug #3485022: tracing Bc'ed commands} -setup {
    set ::traceLog 0
    set ::traceCalls 0
    set res {}
    proc dotrace args {
	incr ::traceLog
    }
    proc foo {} {
	incr ::traceCalls
	string equal zip zap
    }
} -body {
    foo
    lappend res $::traceLog

    trace add execution ::tcl::string::equal enter dotrace
    foo
    lappend res $::traceLog

    trace remove execution tcl::string::equal enter dotrace
    foo
    lappend res $::traceLog

    list $::traceCalls | {*}$res
} -cleanup {
    unset ::traceLog ::traceCalls res
    rename dotrace {}
    rename foo {}
} -result {3 | 0 1 1}
    
# Delete procedures when done, so we don't clash with other tests
# (e.g. foobar will clash with 'unknown' tests).
catch {rename foobar {}}
catch {rename foo {}}
catch {rename bar {}}
catch {rename untraced {}}
catch {rename traceproc {}}

Changes to tests/unixNotfy.test.

16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

# 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.6}]}]
# Darwin always uses a threaded notifier
testConstraint unthreaded [expr {
    (![info exist tcl_platform(threaded)] || !$tcl_platform(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 {







|







16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
}

# 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.6}]}]
# 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 {

Changes to tests/zlib.test.

152
153
154
155
156
157
158












159
160
161
162
163
164
165
    }
    append total --> [file size $file]
} -cleanup {
    close $fout
    close $srv
    removeFile $file
} -result 81920-->81920













test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
    set sfile [makeFile {} testsrc.gz]
    set file [makeFile {} test.gz]
    set f [open $sfile wb]
    puts -nonewline $f [zlib gzip [string repeat a 81920]]
    close $f







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







152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
    }
    append total --> [file size $file]
} -cleanup {
    close $fout
    close $srv
    removeFile $file
} -result 81920-->81920
test zlib-8.4 {transformation and flushing: Bug 3517696} -setup {
    set file [makeFile {} test.z]
    set fd [open $file w]
} -constraints zlib -body {
    zlib push compress $fd
    puts $fd "qwertyuiop"
    fconfigure $fd -flush sync
    puts $fd "qwertyuiop"
} -cleanup {
    catch {close $fd}
    removeFile $file
} -result {}

test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
    set sfile [makeFile {} testsrc.gz]
    set file [makeFile {} test.gz]
    set f [open $sfile wb]
    puts -nonewline $f [zlib gzip [string repeat a 81920]]
    close $f

Changes to unix/Makefile.in.

825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.8.3 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.3.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;







|
|







825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing package http1.0 files to $(SCRIPT_INSTALL_DIR)/http1.0/";
	@for i in $(TOP_DIR)/library/http1.0/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/http1.0; \
	    done;
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/http/http.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing package opt0.4 files to $(SCRIPT_INSTALL_DIR)/opt0.4/";
	@for i in $(TOP_DIR)/library/opt/*.tcl ; \
	    do \
	    $(INSTALL_DATA) $$i "$(SCRIPT_INSTALL_DIR)"/opt0.4; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(INSTALL_DATA) $(TOP_DIR)/library/msgcat/msgcat.tcl "$(SCRIPT_INSTALL_DIR)"/../tcl8/8.5/msgcat-1.4.4.tm;
986
987
988
989
990
991
992

993
994
995
996
997
998
999
REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
		$(GENERIC_DIR)/regcustom.h
TCLREHDRS=$(GENERIC_DIR)/tclRegexp.h
COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h

NREHDR=$(GENERIC_DIR)/tclInt.h

regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c








>







986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
REGHDRS=$(GENERIC_DIR)/regex.h $(GENERIC_DIR)/regguts.h \
		$(GENERIC_DIR)/regcustom.h
TCLREHDRS=$(GENERIC_DIR)/tclRegexp.h
COMPILEHDR=$(GENERIC_DIR)/tclCompile.h
FSHDR=$(GENERIC_DIR)/tclFileSystem.h
IOHDR=$(GENERIC_DIR)/tclIO.h
MATHHDRS=$(GENERIC_DIR)/tommath.h $(GENERIC_DIR)/tclTomMath.h
PARSEHDR=$(GENERIC_DIR)/tclParse.h
NREHDR=$(GENERIC_DIR)/tclInt.h

regcomp.o: $(REGHDRS) $(GENERIC_DIR)/regcomp.c $(GENERIC_DIR)/regc_lex.c \
		$(GENERIC_DIR)/regc_color.c $(GENERIC_DIR)/regc_locale.c \
		$(GENERIC_DIR)/regc_nfa.c $(GENERIC_DIR)/regc_cvec.c
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/regcomp.c

1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196

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

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

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

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

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







|







1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197

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

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

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

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

tclPathObj.o: $(GENERIC_DIR)/tclPathObj.c $(FSHDR)
	$(CC) -c $(CC_SWITCHES) $(GENERIC_DIR)/tclPathObj.c
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
# prefix/exec_prefix but all the different paths individually.

tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
	$(CC)	-c $(CC_SWITCHES)					\
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
		\
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \







|







1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
# Part of Tcl's configuration information are the paths where it was installed
# and where it will look for its libraries (which can be different). We derive
# this information from the variables which can be overridden by the user. As
# every path can be configured separately we do not remember one general
# prefix/exec_prefix but all the different paths individually.

tclPkgConfig.o: $(GENERIC_DIR)/tclPkgConfig.c
	$(CC) -c $(CC_SWITCHES)					\
		-DCFG_INSTALL_LIBDIR="\"$(LIB_INSTALL_DIR)\"" \
		-DCFG_INSTALL_BINDIR="\"$(BIN_INSTALL_DIR)\"" \
		-DCFG_INSTALL_SCRDIR="\"$(SCRIPT_INSTALL_DIR)\"" \
		-DCFG_INSTALL_INCDIR="\"$(INCLUDE_INSTALL_DIR)\"" \
		-DCFG_INSTALL_DOCDIR="\"$(MAN_INSTALL_DIR)\"" \
		\
		-DCFG_RUNTIME_LIBDIR="\"$(libdir)\"" \
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278

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

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

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

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

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

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

tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c

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








|









|







1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279

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

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

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

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

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

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

tclTest.o: $(GENERIC_DIR)/tclTest.c $(IOHDR) $(TCLREHDRS)
	$(CC) -c $(APP_CC_SWITCHES) $(GENERIC_DIR)/tclTest.c

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

1536
1537
1538
1539
1540
1541
1542




1543
1544
1545
1546
1547
1548
1549

tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXFCmd.c

tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c
	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c





# DTrace support

$(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @DTRACE_HDR@

$(DTRACE_HDR): $(DTRACE_SRC)
	$(DTRACE) -h $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC)








>
>
>
>







1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554

tclMacOSXFCmd.o: $(MAC_OSX_DIR)/tclMacOSXFCmd.c
	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXFCmd.c

tclMacOSXNotify.o: $(MAC_OSX_DIR)/tclMacOSXNotify.c
	$(CC) -c $(CC_SWITCHES) $(MAC_OSX_DIR)/tclMacOSXNotify.c

# The following is a CYGWIN only source:
tclWinError.o: $(TOP_DIR)/win/tclWinError.c
	$(CC) -c $(CC_SWITCHES) $(TOP_DIR)/win/tclWinError.c

# DTrace support

$(TCL_OBJS) $(STUB_LIB_OBJS) $(TCLSH_OBJS) $(TCLTEST_OBJS) $(XTTEST_OBJS): @DTRACE_HDR@

$(DTRACE_HDR): $(DTRACE_SRC)
	$(DTRACE) -h $(DTRACE_SWITCHES) -o $@ -s $(DTRACE_SRC)

Changes to unix/configure.

7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063


































































7064
7065
7066
7067
7068
7069
7070
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""


































































	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"







|



|



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







7049
7050
7051
7052
7053
7054
7055
7056
7057
7058
7059
7060
7061
7062
7063
7064
7065
7066
7067
7068
7069
7070
7071
7072
7073
7074
7075
7076
7077
7078
7079
7080
7081
7082
7083
7084
7085
7086
7087
7088
7089
7090
7091
7092
7093
7094
7095
7096
7097
7098
7099
7100
7101
7102
7103
7104
7105
7106
7107
7108
7109
7110
7111
7112
7113
7114
7115
7116
7117
7118
7119
7120
7121
7122
7123
7124
7125
7126
7127
7128
7129
7130
7131
7132
7133
7134
7135
7136
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o tclWinError.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,[email protected]'
	    echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
if test "${ac_cv_cygwin+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

		#ifdef __CYGWIN__
		    #error cygwin
		#endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  ac_cv_cygwin=no
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

ac_cv_cygwin=yes
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
echo "${ECHO_T}$ac_cv_cygwin" >&6
	    if test "$ac_cv_cygwin" = "no"; then
		{ { echo "$as_me:$LINENO: error: ${CC} is not a cygwin compiler." >&5
echo "$as_me: error: ${CC} is not a cygwin compiler." >&2;}
   { (exit 1); exit 1; }; }
	    fi
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
9026
9027
9028
9029
9030
9031
9032
9033
9034
9035
9036
9037
9038
9039
9040
    # standard manufacturer compiler.

    if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi







|







9092
9093
9094
9095
9096
9097
9098
9099
9100
9101
9102
9103
9104
9105
9106
    # standard manufacturer compiler.

    if test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes; then

	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*|MINGW32_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac
fi
9123
9124
9125
9126
9127
9128
9129





































































9130
9131
9132
9133
9134
9135
9136
    # it is already set when tclConfig.sh had been loaded by Tk.
    if test "x${TCL_LIBS}" = x; then

        TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"
fi








































































    # FIXME: This subst was left in only because the TCL_DL_LIBS
    # entry in tclConfig.sh uses it. It is not clear why someone
    # would use TCL_DL_LIBS instead of TCL_LIBS.










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







9189
9190
9191
9192
9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
9212
9213
9214
9215
9216
9217
9218
9219
9220
9221
9222
9223
9224
9225
9226
9227
9228
9229
9230
9231
9232
9233
9234
9235
9236
9237
9238
9239
9240
9241
9242
9243
9244
9245
9246
9247
9248
9249
9250
9251
9252
9253
9254
9255
9256
9257
9258
9259
9260
9261
9262
9263
9264
9265
9266
9267
9268
9269
9270
9271
    # it is already set when tclConfig.sh had been loaded by Tk.
    if test "x${TCL_LIBS}" = x; then

        TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"
fi



	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	echo "$as_me:$LINENO: checking for cast to union support" >&5
echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
if test "${tcl_cv_cast_to_union+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{

		  union foo { int i; double d; };
		  union foo f = (union foo) (int) 0;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_cast_to_union=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_cast_to_union=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
	if test "$tcl_cv_cast_to_union" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_CAST_TO_UNION 1
_ACEOF

	fi

    # FIXME: This subst was left in only because the TCL_DL_LIBS
    # entry in tclConfig.sh uses it. It is not clear why someone
    # would use TCL_DL_LIBS instead of TCL_LIBS.



9180
9181
9182
9183
9184
9185
9186





9187
9188
9189
9190
9191
9192
9193
9194
9195
9196
9197
9198
9199
9200
9201
9202
9203
9204
9205
9206
9207
9208
9209
9210
9211
9212
9213
9214
9215
9216
  tcl_ok=no
fi;
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    DBGX=""
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'





	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6

cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_OPTIMIZED 1
_ACEOF

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
echo "${ECHO_T}yes (standard debugging)" >&6
	fi
    fi


    ### FIXME: Surely TCL_CFG_DEBUG should be set to whether we're debugging?

cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_DEBUG 1
_ACEOF


    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

cat >>confdefs.h <<\_ACEOF
#define TCL_MEM_DEBUG 1
_ACEOF








>
>
>
>
>

















<
<
<
<
<
<







9315
9316
9317
9318
9319
9320
9321
9322
9323
9324
9325
9326
9327
9328
9329
9330
9331
9332
9333
9334
9335
9336
9337
9338
9339
9340
9341
9342
9343






9344
9345
9346
9347
9348
9349
9350
  tcl_ok=no
fi;
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    DBGX=""
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'

cat >>confdefs.h <<\_ACEOF
#define NDEBUG 1
_ACEOF

	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6

cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_OPTIMIZED 1
_ACEOF

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
echo "${ECHO_T}yes (standard debugging)" >&6
	fi
    fi









    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

cat >>confdefs.h <<\_ACEOF
#define TCL_MEM_DEBUG 1
_ACEOF

14248
14249
14250
14251
14252
14253
14254

14255
14256
14257
14258
14259
14260
14261

#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------


echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */







>







14382
14383
14384
14385
14386
14387
14388
14389
14390
14391
14392
14393
14394
14395
14396

#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" != "yes"; then
echo "$as_me:$LINENO: checking for struct stat.st_blocks" >&5
echo $ECHO_N "checking for struct stat.st_blocks... $ECHO_C" >&6
if test "${ac_cv_member_struct_stat_st_blocks+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
14467
14468
14469
14470
14471
14472
14473

14474
14475
14476
14477
14478
14479
14480
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLKSIZE 1
_ACEOF


fi


echo "$as_me:$LINENO: checking for blkcnt_t" >&5
echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6
if test "${ac_cv_type_blkcnt_t+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */







>







14602
14603
14604
14605
14606
14607
14608
14609
14610
14611
14612
14613
14614
14615
14616
cat >>confdefs.h <<_ACEOF
#define HAVE_STRUCT_STAT_ST_BLKSIZE 1
_ACEOF


fi

fi
echo "$as_me:$LINENO: checking for blkcnt_t" >&5
echo $ECHO_N "checking for blkcnt_t... $ECHO_C" >&6
if test "${ac_cv_type_blkcnt_t+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */

Changes to unix/configure.in.

294
295
296
297
298
299
300

301

302
303
304
305
306
307
308

#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------


AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])

AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

#--------------------------------------------------------------------
#       Some system have no memcmp or it does not work with 8 bit data, this
#       checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------







>

>







294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310

#--------------------------------------------------------------------
#	Some systems (e.g., IRIX 4.0.5) lack some fields in struct stat. But
#	we might be able to use fstatfs instead. Some systems (OpenBSD?) also
#	lack blkcnt_t.
#--------------------------------------------------------------------

if test "$ac_cv_cygwin" != "yes"; then
AC_CHECK_MEMBERS([struct stat.st_blocks, struct stat.st_blksize])
fi
AC_CHECK_TYPES([blkcnt_t])
AC_CHECK_FUNC(fstatfs, , [AC_DEFINE(NO_FSTATFS, 1, [Do we have fstatfs()?])])

#--------------------------------------------------------------------
#       Some system have no memcmp or it does not work with 8 bit data, this
#       checks it and add memcmp.o to LIBOBJS if needed
#--------------------------------------------------------------------
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
#	"union wait" correctly.  It's needed because of weirdness in
#	HP-UX where "union wait" is defined in both the BSD and SYS-V
#	environments.  Checking the usability of WIFEXITED seems to do
#	the trick.
#--------------------------------------------------------------------

AC_CACHE_CHECK([union wait], tcl_cv_union_wait, [
    AC_TRY_LINK([#include <sys/types.h> 
#include <sys/wait.h>], [
union wait x;
WIFEXITED(x);		/* Generates compiler error if WIFEXITED
			 * uses an int. */
    ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no)])
if test $tcl_cv_union_wait = no; then
    AC_DEFINE(NO_UNION_WAIT, 1, [Do we have a usable 'union wait'?])







|







430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
#	"union wait" correctly.  It's needed because of weirdness in
#	HP-UX where "union wait" is defined in both the BSD and SYS-V
#	environments.  Checking the usability of WIFEXITED seems to do
#	the trick.
#--------------------------------------------------------------------

AC_CACHE_CHECK([union wait], tcl_cv_union_wait, [
    AC_TRY_LINK([#include <sys/types.h>
#include <sys/wait.h>], [
union wait x;
WIFEXITED(x);		/* Generates compiler error if WIFEXITED
			 * uses an int. */
    ], tcl_cv_union_wait=yes, tcl_cv_union_wait=no)])
if test $tcl_cv_union_wait = no; then
    AC_DEFINE(NO_UNION_WAIT, 1, [Do we have a usable 'union wait'?])
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
    TCL_LIB_SPEC="-F${libdir} -framework Tcl"
    libdir="${libdir}/Tcl.framework/Versions/\${VERSION}"
    TCL_LIBRARY="${libdir}/Resources/Scripts"
    includedir="${libdir}/Headers"
    PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders"
    HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl"
    EXTRA_INSTALL="install-private-headers html-tcl"
    EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html' 
    EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"'
    EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"'
    EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."'
    # Don't use AC_DEFINE for the following as the framework version define 
    # needs to go into the Makefile even when using autoheader, so that we  
    # can pick up a potential make override of VERSION. Also, don't put this
    # into CFLAGS as it should not go into tclConfig.sh
    EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"'
else
    # libdir must be a fully qualified path and not ${exec_prefix}/lib
    eval libdir="$libdir"
    # default install directory for bundled packages







|



|
|







813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
    TCL_LIB_SPEC="-F${libdir} -framework Tcl"
    libdir="${libdir}/Tcl.framework/Versions/\${VERSION}"
    TCL_LIBRARY="${libdir}/Resources/Scripts"
    includedir="${libdir}/Headers"
    PRIVATE_INCLUDE_DIR="${libdir}/PrivateHeaders"
    HTML_DIR="${libdir}/Resources/Documentation/Reference/Tcl"
    EXTRA_INSTALL="install-private-headers html-tcl"
    EXTRA_BUILD_HTML='@ln -fs contents.htm "$(HTML_INSTALL_DIR)"/TclTOC.html'
    EXTRA_INSTALL_BINARIES='@echo "Installing Info.plist to $(LIB_INSTALL_DIR)/Resources" && mkdir -p "$(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) Tcl-Info.plist "$(LIB_INSTALL_DIR)/Resources/Info.plist"'
    EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Installing license.terms to $(LIB_INSTALL_DIR)/Resources" && $(INSTALL_DATA) "$(TOP_DIR)/license.terms" "$(LIB_INSTALL_DIR)/Resources"'
    EXTRA_INSTALL_BINARIES="$EXTRA_INSTALL_BINARIES"' && echo "Finalizing Tcl.framework" && rm -f "$(LIB_INSTALL_DIR)/../Current" && ln -s "$(VERSION)" "$(LIB_INSTALL_DIR)/../Current" && for f in "$(LIB_FILE)" tclConfig.sh Resources Headers PrivateHeaders; do rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/Current/$$f" "$(LIB_INSTALL_DIR)/../.."; done && f="$(STUB_LIB_FILE)" && rm -f "$(LIB_INSTALL_DIR)/../../$$f" && ln -s "Versions/$(VERSION)/$$f" "$(LIB_INSTALL_DIR)/../.."'
    # Don't use AC_DEFINE for the following as the framework version define
    # needs to go into the Makefile even when using autoheader, so that we
    # can pick up a potential make override of VERSION. Also, don't put this
    # into CFLAGS as it should not go into tclConfig.sh
    EXTRA_CC_SWITCHES='-DTCL_FRAMEWORK_VERSION=\"$(VERSION)\"'
else
    # libdir must be a fully qualified path and not ${exec_prefix}/lib
    eval libdir="$libdir"
    # default install directory for bundled packages

Changes to unix/tcl.m4.

734
735
736
737
738
739
740

741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
	    [build with debugging symbols (default: off)]),
	[tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    DBGX=""
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'

	AC_MSG_RESULT([no])
	AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?])
    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    AC_MSG_RESULT([yes (standard debugging)])
	fi
    fi
    AC_SUBST(CFLAGS_DEFAULT)
    AC_SUBST(LDFLAGS_DEFAULT)
    ### FIXME: Surely TCL_CFG_DEBUG should be set to whether we're debugging?
    AC_DEFINE(TCL_CFG_DEBUG, 1, [Is debugging enabled?])

    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
	AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?])
    fi

    ifelse($1,bccdebug,dnl Only enable 'compile' for the Tcl core itself
	if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then







>











<
<







734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752


753
754
755
756
757
758
759
	    [build with debugging symbols (default: off)]),
	[tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    DBGX=""
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
	AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?])
	AC_MSG_RESULT([no])
	AC_DEFINE(TCL_CFG_OPTIMIZED, 1, [Is this an optimized build?])
    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	if test "$tcl_ok" = "yes"; then
	    AC_MSG_RESULT([yes (standard debugging)])
	fi
    fi
    AC_SUBST(CFLAGS_DEFAULT)
    AC_SUBST(LDFLAGS_DEFAULT)



    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
	AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?])
    fi

    ifelse($1,bccdebug,dnl Only enable 'compile' for the Tcl core itself
	if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
















1231
1232
1233
1234
1235
1236
1237
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
















	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"







|



|



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







1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
	    DL_LIBS="-ldl"
	    LDFLAGS="$LDFLAGS -export-dynamic"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    ;;
	CYGWIN_*|MINGW32*)
	    SHLIB_CFLAGS=""
	    SHLIB_LD='${CC} -shared'
	    SHLIB_SUFFIX=".dll"
	    DL_OBJS="tclLoadDl.o tclWinError.o"
	    DL_LIBS="-ldl"
	    CC_SEARCH_FLAGS=""
	    LD_SEARCH_FLAGS=""
	    TCL_NEEDS_EXP_FILE=1
	    TCL_EXPORT_FILE_SUFFIX='${VERSION}\$\{DBGX\}.dll.a'
	    TCL_SHLIB_LD_EXTRAS='-Wl,--out-implib,$[@].a'
	    AC_CACHE_CHECK(for Cygwin version of gcc,
		ac_cv_cygwin,
		AC_TRY_COMPILE([
		#ifdef __CYGWIN__
		    #error cygwin
		#endif
		], [],
		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
	    ;;
	dgux*)
	    SHLIB_CFLAGS="-K PIC"
	    SHLIB_LD='${CC} -G'
	    SHLIB_LD_LIBS=""
	    SHLIB_SUFFIX=".so"
	    DL_OBJS="tclLoadDl.o"
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
    # libraries to the right flags for gcc, instead of those for the
    # standard manufacturer compiler.

    AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])








|







2066
2067
2068
2069
2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
    # libraries to the right flags for gcc, instead of those for the
    # standard manufacturer compiler.

    AS_IF([test "$DL_OBJS" != "tclLoadNone.o" -a "$GCC" = yes], [
	case $system in
	    AIX-*) ;;
	    BSD/OS*) ;;
	    CYGWIN_*|MINGW32_*) ;;
	    IRIX*) ;;
	    NetBSD-*|FreeBSD-*|OpenBSD-*) ;;
	    Darwin-*) ;;
	    SCO_SV-3.2*) ;;
	    *) SHLIB_CFLAGS="-fPIC" ;;
	esac])

2107
2108
2109
2110
2111
2112
2113



















2114
2115
2116
2117
2118
2119
2120

    # Define TCL_LIBS now that we know what DL_LIBS is.
    # The trick here is that we don't want to change the value of TCL_LIBS if
    # it is already set when tclConfig.sh had been loaded by Tk.
    AS_IF([test "x${TCL_LIBS}" = x], [
        TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"])
    AC_SUBST(TCL_LIBS)




















    # FIXME: This subst was left in only because the TCL_DL_LIBS
    # entry in tclConfig.sh uses it. It is not clear why someone
    # would use TCL_DL_LIBS instead of TCL_LIBS.
    AC_SUBST(DL_LIBS)

    AC_SUBST(DL_OBJS)







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







2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154

    # Define TCL_LIBS now that we know what DL_LIBS is.
    # The trick here is that we don't want to change the value of TCL_LIBS if
    # it is already set when tclConfig.sh had been loaded by Tk.
    AS_IF([test "x${TCL_LIBS}" = x], [
        TCL_LIBS="${DL_LIBS} ${LIBS} ${MATH_LIBS}"])
    AC_SUBST(TCL_LIBS)

	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	AC_CACHE_CHECK(for cast to union support,
	    tcl_cv_cast_to_union,
	    AC_TRY_COMPILE([],
	    [
		  union foo { int i; double d; };
		  union foo f = (union foo) (int) 0;
	    ],
	    tcl_cv_cast_to_union=yes,
	    tcl_cv_cast_to_union=no)
	)
	if test "$tcl_cv_cast_to_union" = "yes"; then
	    AC_DEFINE(HAVE_CAST_TO_UNION, 1,
		    [Defined when compiler supports casting to union type.])
	fi

    # FIXME: This subst was left in only because the TCL_DL_LIBS
    # entry in tclConfig.sh uses it. It is not clear why someone
    # would use TCL_DL_LIBS instead of TCL_LIBS.
    AC_SUBST(DL_LIBS)

    AC_SUBST(DL_OBJS)

Changes to unix/tclConfig.h.in.

358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
/* Define to 1 if you have the ANSI C header files. */
#undef STDC_HEADERS

/* What encoding should be used for embedded configuration info? */
#undef TCL_CFGVAL_ENCODING

/* Is debugging enabled? */
#undef TCL_CFG_DEBUG

/* Is this a 64-bit build? */
#undef TCL_CFG_DO64BIT

/* Is this an optimized build? */
#undef TCL_CFG_OPTIMIZED








|







358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
/* Define to 1 if you have the ANSI C header files. */
#undef STDC_HEADERS

/* What encoding should be used for embedded configuration info? */
#undef TCL_CFGVAL_ENCODING

/* Is debugging enabled? */
#undef NDEBUG

/* Is this a 64-bit build? */
#undef TCL_CFG_DO64BIT

/* Is this an optimized build? */
#undef TCL_CFG_OPTIMIZED

Changes to unix/tclUnixCompat.c.

953
954
955
956
957
958
959





































960
961
962
963
964
965
966
	memcpy(buf, src, len);
    }

    return len;
}
#endif /* NEED_COPYSTRING */






































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







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







953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
	memcpy(buf, src, len);
    }

    return len;
}
#endif /* NEED_COPYSTRING */

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

/*
 *------------------------------------------------------------------------
 *
 * TclWinCPUID --
 *
 *	Get CPU ID information on an Intel box under UNIX (either Linux or Cygwin)
 *
 * Results:
 *	Returns TCL_OK if successful, TCL_ERROR if CPUID is not supported or
 *	fails.
 *
 * Side effects:
 *	If successful, stores EAX, EBX, ECX and EDX registers after the CPUID
 *	instruction in the four integers designated by 'regsPtr'
 *
 *----------------------------------------------------------------------
 */

int
TclWinCPUID(
    unsigned int index,		/* Which CPUID value to retrieve. */
    unsigned int *regsPtr)	/* Registers after the CPUID. */
{
    int status = TCL_ERROR;

    /* There is no reason this couldn't be implemented on UNIX as well */
    return status;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to unix/tclUnixFile.c.

1174
1175
1176
1177
1178
1179
1180


































1181
1182
1183
1184
1185
1186
1187
int
TclpUtime(
    Tcl_Obj *pathPtr,		/* File to modify */
    struct utimbuf *tval)	/* New modification date structure */
{
    return utime(Tcl_FSGetNativePath(pathPtr), tval);
}



































/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:







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







1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
int
TclpUtime(
    Tcl_Obj *pathPtr,		/* File to modify */
    struct utimbuf *tval)	/* New modification date structure */
{
    return utime(Tcl_FSGetNativePath(pathPtr), tval);
}
#ifdef __CYGWIN__
int TclOSstat(const char *name, Tcl_StatBuf *statBuf) {
    struct stat buf;
    int result = stat(name, &buf);
    statBuf->st_mode = buf.st_mode;
    statBuf->st_ino = buf.st_ino;
    statBuf->st_dev = buf.st_dev;
    statBuf->st_rdev = buf.st_rdev;
    statBuf->st_nlink = buf.st_nlink;
    statBuf->st_uid = buf.st_uid;
    statBuf->st_gid = buf.st_gid;
    statBuf->st_size = buf.st_size;
    statBuf->st_atime = buf.st_atime;
    statBuf->st_mtime = buf.st_mtime;
    statBuf->st_ctime = buf.st_ctime;
    return result;
}
int TclOSlstat(const char *name, Tcl_StatBuf *statBuf) {
    struct stat buf;
    int result = lstat(name, &buf);
    statBuf->st_mode = buf.st_mode;
    statBuf->st_ino = buf.st_ino;
    statBuf->st_dev = buf.st_dev;
    statBuf->st_rdev = buf.st_rdev;
    statBuf->st_nlink = buf.st_nlink;
    statBuf->st_uid = buf.st_uid;
    statBuf->st_gid = buf.st_gid;
    statBuf->st_size = buf.st_size;
    statBuf->st_atime = buf.st_atime;
    statBuf->st_mtime = buf.st_mtime;
    statBuf->st_ctime = buf.st_ctime;
    return result;
}
#endif

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:

Changes to unix/tclUnixPort.h.

74
75
76
77
78
79
80



81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98

99

100
101
102
103
104
105
106
#   define TclOSopen		open64
#else
typedef off_t		Tcl_SeekOffset;
#   define TclOSseek		lseek
#   define TclOSopen		open
#endif




#ifdef HAVE_STRUCT_STAT64
#   define TclOSstat		stat64
#   define TclOSlstat		lstat64
#else
#   define TclOSstat		stat
#   define TclOSlstat		lstat
#endif

/*
 *---------------------------------------------------------------------------
 * Miscellaneous includes that might be missing.
 *---------------------------------------------------------------------------
 */

#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
#   include <sys/select.h>
#endif

#include <sys/stat.h>

#if TIME_WITH_SYS_TIME
#   include <sys/time.h>
#   include <time.h>
#else
#if HAVE_SYS_TIME_H
#   include <sys/time.h>
#else







>
>
>
|

















>
|
>







74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#   define TclOSopen		open64
#else
typedef off_t		Tcl_SeekOffset;
#   define TclOSseek		lseek
#   define TclOSopen		open
#endif

#ifdef __CYGWIN__
MODULE_SCOPE int TclOSstat(const char *name, Tcl_StatBuf *statBuf);
MODULE_SCOPE int TclOSlstat(const char *name, Tcl_StatBuf *statBuf);
#elif defined(HAVE_STRUCT_STAT64)
#   define TclOSstat		stat64
#   define TclOSlstat		lstat64
#else
#   define TclOSstat		stat
#   define TclOSlstat		lstat
#endif

/*
 *---------------------------------------------------------------------------
 * Miscellaneous includes that might be missing.
 *---------------------------------------------------------------------------
 */

#include <sys/file.h>
#ifdef HAVE_SYS_SELECT_H
#   include <sys/select.h>
#endif
#ifdef HAVE_SYS_STAT_H
#   include <sys/stat.h>
#endif
#if TIME_WITH_SYS_TIME
#   include <sys/time.h>
#   include <time.h>
#else
#if HAVE_SYS_TIME_H
#   include <sys/time.h>
#else

Changes to unix/tclUnixSock.c.

1248
1249
1250
1251
1252
1253
1254







1255
1256
1257
1258
1259
1260

1261




1262
1263
1264
1265
1266
1267
1268
    int status = 0, sock = -1, reuseaddr = 1, chosenport = 0;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */
    TcpState *statePtr = NULL;
    char channelName[SOCK_CHAN_LENGTH];
    const char *errorMsg = NULL;
    TcpFdList *fds = NULL, *newfds;








    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
	goto error;
    }

    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);

	if (sock == -1) {




	    continue;
	}
	
	/*
	 * Set the close-on-exec flag so that the socket will not get
	 * inherited by child processes.
	 */







>
>
>
>
>
>
>





|
>

>
>
>
>







1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
    int status = 0, sock = -1, reuseaddr = 1, chosenport = 0;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */
    TcpState *statePtr = NULL;
    char channelName[SOCK_CHAN_LENGTH];
    const char *errorMsg = NULL;
    TcpFdList *fds = NULL, *newfds;

    /*
     * Try to record and return the most meaningful error message, i.e. the
     * one from the first socket that went the farthest before it failed.
     */
    enum { START, SOCKET, BIND, LISTEN } howfar = START;
    int my_errno = 0;

    if (!TclCreateSocketAddress(interp, &addrlist, myHost, port, 1, &errorMsg)) {
	goto error;
    }

    for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	sock = socket(addrPtr->ai_family, addrPtr->ai_socktype,
                      addrPtr->ai_protocol);
	if (sock == -1) {
	    if (howfar < SOCKET) {
		howfar = SOCKET;
		my_errno = errno;
	    }
	    continue;
	}
	
	/*
	 * Set the close-on-exec flag so that the socket will not get
	 * inherited by child processes.
	 */
1304
1305
1306
1307
1308
1309
1310




1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328




1329
1330
1331
1332
1333
1334
1335
            (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
                    &v6only, sizeof(v6only));
        }
#endif

	status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
        if (status == -1) {




            close(sock);
            continue;
        }
        if (port == 0 && chosenport == 0) {
            address sockname;
            socklen_t namelen = sizeof(sockname);

            /*
             * Synchronize port numbers when binding to port 0 of multiple
             * addresses.
             */

            if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
                chosenport = ntohs(sockname.sa4.sin_port);
            }
        }
        status = listen(sock, SOMAXCONN);
        if (status < 0) {




            close(sock);
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */







>
>
>
>


















>
>
>
>







1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
            (void) setsockopt(sock, IPPROTO_IPV6, IPV6_V6ONLY,
                    &v6only, sizeof(v6only));
        }
#endif

	status = bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen);
        if (status == -1) {
	    if (howfar < BIND) {
		howfar = BIND;
		my_errno = errno;
	    }       
            close(sock);
            continue;
        }
        if (port == 0 && chosenport == 0) {
            address sockname;
            socklen_t namelen = sizeof(sockname);

            /*
             * Synchronize port numbers when binding to port 0 of multiple
             * addresses.
             */

            if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
                chosenport = ntohs(sockname.sa4.sin_port);
            }
        }
        status = listen(sock, SOMAXCONN);
        if (status < 0) {
	    if (howfar < LISTEN) {
		howfar = LISTEN;
		my_errno = errno;
	    }
            close(sock);
            continue;
        }
        if (statePtr == NULL) {
            /*
             * Allocate a new TcpState for this socket.
             */
1363
1364
1365
1366
1367
1368
1369

1370
1371
1372
1373
1374
1375
1376
    }
    if (statePtr != NULL) {
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	return statePtr->channel;
    }
    if (interp != NULL) {

	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
	if (errorMsg != NULL) {
	    Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
	}
    }
    if (sock != -1) {







>







1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
    }
    if (statePtr != NULL) {
	statePtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
		statePtr, 0);
	return statePtr->channel;
    }
    if (interp != NULL) {
	errno = my_errno;
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
	if (errorMsg != NULL) {
	    Tcl_AppendResult(interp, " (", errorMsg, ")", NULL);
	}
    }
    if (sock != -1) {

Changes to unix/tclUnixTime.c.

216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
#error Wide high-resolution clicks not implemented on this platform
#endif
    }

    return nsec;
}
#endif /* TCL_WIDE_CLICKS */

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTimeZone --
 *
 *	Determines the current timezone. The method varies wildly between
 *	different platform implementations, so its hidden in this function.
 *
 * Results:
 *	The return value is the local time zone, measured in minutes away from
 *	GMT (-ve for east, +ve for west).
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpGetTimeZone(
    unsigned long currentTime)
{
    int timeZone;

    /*
     * We prefer first to use the time zone in "struct tm" if the structure
     * contains such a member. Following that, we try to locate the external
     * 'timezone' variable and use its value. If both of those methods fail,
     * we attempt to convert a known time to local time and use the difference
     * from UTC as the local time zone. In all cases, we need to undo any
     * Daylight Saving Time adjustment.
     */

#if defined(HAVE_TM_TZADJ)
#define TCL_GOT_TIMEZONE
    /*
     * Struct tm contains tm_tzadj - that value may be used.
     */

    time_t curTime = (time_t) currentTime;
    struct tm *timeDataPtr = TclpLocaltime(&curTime);

    timeZone = timeDataPtr->tm_tzadj / 60;
    if (timeDataPtr->tm_isdst) {
	timeZone += 60;
    }
#endif

#if defined(HAVE_TM_GMTOFF) && !defined (TCL_GOT_TIMEZONE)
#define TCL_GOT_TIMEZONE
    /*
     * Struct tm contains tm_gmtoff - that value may be used.
     */

    time_t curTime = (time_t) currentTime;
    struct tm *timeDataPtr = TclpLocaltime(&curTime);

    timeZone = -(timeDataPtr->tm_gmtoff / 60);
    if (timeDataPtr->tm_isdst) {
	timeZone += 60;
    }
#endif

#if defined(HAVE_TIMEZONE_VAR) && !defined(TCL_GOT_TIMEZONE) && !defined(USE_DELTA_FOR_TZ)
#define TCL_GOT_TIMEZONE
    /*
     * The 'timezone' external var is present and may be used.
     */

    SetTZIfNecessary();

    /*
     * Note: this is not a typo in "timezone" below! See tzset documentation
     * for details.
     */

    timeZone = timezone / 60;
#endif

#if !defined(TCL_GOT_TIMEZONE)
#define TCL_GOT_TIMEZONE
    /*
     * Fallback - determine time zone with a known reference time.
     */

    time_t tt;
    struct tm *stm;

    tt = 849268800L;		/* 1996-11-29 12:00:00  GMT */
    stm = TclpLocaltime(&tt);	/* eg 1996-11-29  6:00:00  CST6CDT */

    /*
     * The calculation below assumes a max of +12 or -12 hours from GMT.
     */

    timeZone = (12 - stm->tm_hour)*60 + (0 - stm->tm_min);
    if (stm->tm_isdst) {
	timeZone += 60;
    }

    /*
     * Now have offset for our known reference time, eg +360 for CST6CDT.
     */
#endif

#ifndef TCL_GOT_TIMEZONE
    /*
     * Cause fatal compile error, we don't know how to get timezone.
     */

#error autoconf did not figure out how to determine the timezone.
#endif

    return timeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds since the







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







216
217
218
219
220
221
222




















































































































223
224
225
226
227
228
229
#error Wide high-resolution clicks not implemented on this platform
#endif
    }

    return nsec;
}
#endif /* TCL_WIDE_CLICKS */





















































































































/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds since the

Changes to win/Makefile.in.

658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.8.3 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.3.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;







|
|







658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
	    $(COPY) "$$i" "$(SCRIPT_INSTALL_DIR)"; \
	    done;
	@echo "Installing library http1.0 directory";
	@for j in $(ROOT_DIR)/library/http1.0/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/http1.0"; \
	    done;
	@echo "Installing package http 2.8.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/http/http.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.6/http-2.8.4.tm;
	@echo "Installing library opt0.4 directory";
	@for j in $(ROOT_DIR)/library/opt/*.tcl; \
	    do \
	    $(COPY) "$$j" "$(SCRIPT_INSTALL_DIR)/opt0.4"; \
	    done;
	@echo "Installing package msgcat 1.4.4 as a Tcl Module";
	@$(COPY) $(ROOT_DIR)/library/msgcat/msgcat.tcl $(SCRIPT_INSTALL_DIR)/../tcl8/8.5/msgcat-1.4.4.tm;

Changes to win/README.

19
20
21
22
23
24
25
26


27

28


29

30


31

32









33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51







52
53
54
55
56
57
58
	Tcl 8.6 Source Distribution (plus any patches)

	and

	Visual C++ 6 or newer

	or



	Msys + Mingw [http://www.mingw.org/download.shtml]






Please note that building under Cygwin is NOT supported,


do not file a bug report about building under Cygwin.











In practice, this release is built with Visual C++ 6.0 and the TEA
Makefile.

If you are building with Visual C++, in the "win" subdirectory of the
source release, you will find "makefile.vc".  This is the makefile for the
Visual C++ compiler and uses the stock NMAKE tool.  Detailed directions for
using it, are in the comments of "makefile.vc".  A quick example would be:

	C:\tcl_source\win\>nmake -f makefile.vc

There is also a Developer Studio workspace and project file, too, if you
would like to use them.

If you are building with Msys, you can use the configure script that lives
in the win subdirectory. The Msys based configure/build process works just
like the UNIX one, so you will want to refer to ../unix/README for
available configure options. An error will be generated by the configure
script if you try to compile Tcl with the Cygwin version of gcc instead of
the Mingw version. Check your PATH if you get this error.








Use the Makefile "install" target to install Tcl.  It will install it
according to the prefix options you provided in the correct directory
structure.

Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on
your path, in the system directory, or in the directory containing








>
>
|
>

>
>

>
|
>
>
|
>

>
>
>
>
>
>
>
>
>













|
|
|
|
|
|
>
>
>
>
>
>
>







19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
	Tcl 8.6 Source Distribution (plus any patches)

	and

	Visual C++ 6 or newer

	or

	Linux + MinGW-w64 (any distribution e.g. Ubuntu)
	    (for either 32-bit or 64-bit executables)

	or

	Cygwin + MinGW-w64 [http://cygwin.com/install.html]
	    (for either 32-bit or 64-bit executables)

	or

	Darwin + MinGW-w64 [http://mingw-w64.sourceforge.net/]
	    (for either 32-bit or 64-bit executables)

	or

	Msys + MinGW-w64 [http://mingw-w64.sourceforge.net/]
	    (for either 32-bit or 64-bit executables)

	or

	Msys + Mingw [http://www.mingw.org/download.shtml]
	    (32-bit executables only)


In practice, this release is built with Visual C++ 6.0 and the TEA
Makefile.

If you are building with Visual C++, in the "win" subdirectory of the
source release, you will find "makefile.vc".  This is the makefile for the
Visual C++ compiler and uses the stock NMAKE tool.  Detailed directions for
using it, are in the comments of "makefile.vc".  A quick example would be:

	C:\tcl_source\win\>nmake -f makefile.vc

There is also a Developer Studio workspace and project file, too, if you
would like to use them.

If you are building with Linux, Cygwin or Msys, you can use the configure
script that lives in the win subdirectory. The Linux/Cygwin/Msys based
configure/build process works just like the UNIX one, so you will want
to refer to ../unix/README for available configure options.

If you want 64-bit executables (x86_64), you need to configure using
the --enable-64bit option. Then make sure that the x86_64-w64-mingw32
compiler is present. For Cygwin this compiler can be found in the
"mingw64-x86_64-gcc-core" package, which can be installed through
the normal Cygwin install process. If you only want 32-bit executables,
the "mingw64-i686-gcc-core" package is what you need. If your Linux
distribution does not have a MinGW-w64 package, you can download one
from [https://sourceforge.net/projects/mingw-w64/files/]

Use the Makefile "install" target to install Tcl.  It will install it
according to the prefix options you provided in the correct directory
structure.

Note that in order to run tclsh86.exe, you must ensure that tcl86.dll is on
your path, in the system directory, or in the directory containing

Changes to win/cat.c.

12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
#ifdef TCL_BROKEN_MAINARGS
/* On mingw32 and cygwin this doesn't work */
#   undef UNICODE
#   undef _UNICODE
#endif

#include <stdio.h>
#ifdef __CYGWIN__
#   include <unistd.h>
#else
#   include <io.h>
#endif
#include <string.h>
#include <tchar.h>

int
_tmain(void)
{
    char buf[1024];







<
<
<
|
<







12
13
14
15
16
17
18



19

20
21
22
23
24
25
26
#ifdef TCL_BROKEN_MAINARGS
/* On mingw32 and cygwin this doesn't work */
#   undef UNICODE
#   undef _UNICODE
#endif

#include <stdio.h>



#include <io.h>

#include <string.h>
#include <tchar.h>

int
_tmain(void)
{
    char buf[1024];

Changes to win/configure.

3038
3039
3040
3041
3042
3043
3044
3045
3046
3047
3048
3049
3050
3051
3052
3053
3054
3055
3056
3057
3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
3079
3080
3081
3082
3083
3084
3085
3086
3087
3088
3089
3090
3091
3092
3093
3094
3095
3096
3097
3098
3099
3100
3101
3102
3103
3104
3105
3106
3107
3108
3109
3110
3111
3112
3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
3134
3135
3136
3137
3138
3139
3140
3141
3142
3143
3144
3145
3146
3147
3148
3149
3150
3151
3152
3153
3154
3155
3156
3157
3158
3159
3160
3161
3162
3163
3164
3165
3166
3167
3168
3169
3170
3171
3172
3173
3174
3175
3176
3177
3178
3179
3180
3181
3182
3183
3184
3185
3186
3187
3188
3189
3190
3191
3192
3193
3194
3195
3196
3197
3198
3199
3200
3201
3202
3203
3204
3205
3206
3207
3208
3209
3210
3211
3212
3213
3214
3215
3216
3217
3218
3219
3220
3221
3222
3223
3224
3225
3226
3227
3228
3229
3230
3231
3232
3233
3234
3235
3236
3237
3238
3239
3240
3241
3242
3243
3244
3245
3246
3247
3248
3249
3250
3251
3252
3253
3254
3255
3256
3257
3258
3259
3260
3261
3262
3263
3264
3265
3266
3267
3268
3269
3270
3271
3272
3273
3274
3275
3276
3277
3278
3279
3280
3281
3282
3283
3284
3285
3286
3287
3288
3289
3290
3291
3292
3293
3294
3295
3296
3297
3298
3299
3300
3301
3302
3303
3304
3305
3306
3307
3308
3309
3310
3311
3312
3313
3314
3315
3316
3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411
3412
3413
3414
3415
3416
3417
3418
3419
3420
3421
3422
3423
3424
3425
3426
3427
3428
3429
3430
3431
3432
3433
3434
3435
3436
3437
3438
3439
3440
3441
3442
3443
3444
3445
3446
3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467
3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493
3494
3495
3496
3497
3498
3499
3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
3534
3535
3536
3537
3538
3539
3540
3541
3542
3543
3544
3545
3546
3547
3548
3549
3550
3551
3552
3553
3554
3555
3556
3557
3558
3559
3560
3561
3562
3563
3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
3607
3608
3609
3610
3611
3612
3613
3614
3615
3616
3617
3618
3619
3620
3621
3622
3623
3624
3625
3626
3627
3628
3629
3630
3631
3632
3633
3634
3635
3636
3637
3638
3639
3640
3641
3642
3643
3644
3645
3646
3647
3648
3649
3650
3651
3652
3653
3654
3655
3656
3657
3658
3659
3660
3661
3662
3663
3664
3665
3666
3667
3668
3669
3670
3671
3672
3673
3674
3675
3676
3677
3678
3679
3680
3681
3682
3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
3700
3701
3702
3703
3704
3705
3706
3707
3708
3709
3710
3711
3712
3713
3714
3715
3716
3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
3737
3738
3739
3740
3741
3742
3743
3744
3745
3746
3747
3748
3749
3750
3751
3752
3753
3754
3755
3756
3757
3758
3759
3760
3761
3762
3763
3764
3765
3766
3767
3768
3769
3770
3771
3772
3773
3774
else
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
  SET_MAKE="MAKE=${MAKE-make}"
fi


#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------


echo "$as_me:$LINENO: checking for SEH support in compiler" >&5
echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6
if test "${tcl_cv_seh+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test "$cross_compiling" = yes; then
  tcl_cv_seh=no
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int main(int argc, char** argv) {
    int a, b = 0;
    __try {
        a = 666 / b;
    }
    __except (EXCEPTION_EXECUTE_HANDLER) {
        return 0;
    }
    return 1;
}

_ACEOF
rm -f conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
  (eval $ac_link) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_seh=yes
else
  echo "$as_me: program exited with status $ac_status" >&5
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

( exit $ac_status )
tcl_cv_seh=no
fi
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi

fi
echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5
echo "${ECHO_T}$tcl_cv_seh" >&6
if test "$tcl_cv_seh" = "no" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_SEH 1
_ACEOF

fi

#
# Check to see if the excpt.h include file provided contains the
# definition for EXCEPTION_DISPOSITION; if not, which is the case
# with Cygwin's version as of 2002-04-10, define it to be int,
# sufficient for getting the current code to work.
#
echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5
echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6
if test "${tcl_cv_eh_disposition+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main ()
{

  EXCEPTION_DISPOSITION x;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_eh_disposition=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_eh_disposition=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5
echo "${ECHO_T}$tcl_cv_eh_disposition" >&6
if test "$tcl_cv_eh_disposition" = "no" ; then

cat >>confdefs.h <<\_ACEOF
#define EXCEPTION_DISPOSITION int
_ACEOF

fi


# Check to see if the winsock2.h include file provided contains
# typedefs like LPFN_ACCEPT and friends.
#
echo "$as_me:$LINENO: checking for LPFN_ACCEPT support in winsock2.h" >&5
echo $ECHO_N "checking for LPFN_ACCEPT support in winsock2.h... $ECHO_C" >&6
if test "${tcl_cv_lpfn_decls+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <winsock2.h>

int
main ()
{

  LPFN_ACCEPT accept;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_lpfn_decls=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_lpfn_decls=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_lpfn_decls" >&5
echo "${ECHO_T}$tcl_cv_lpfn_decls" >&6
if test "$tcl_cv_lpfn_decls" = "no" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_LPFN_DECLS 1
_ACEOF

fi

# Check to see if winnt.h defines CHAR, SHORT, and LONG
# even if VOID has already been #defined. The win32api
# used by mingw and cygwin is known to do this.

echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5
echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6
if test "${tcl_cv_winnt_ignore_void+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define VOID void
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main ()
{

  CHAR c;
  SHORT s;
  LONG l;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_winnt_ignore_void=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_winnt_ignore_void=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5
echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6
if test "$tcl_cv_winnt_ignore_void" = "yes" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_WINNT_IGNORE_VOID 1
_ACEOF

fi

# Check to see if malloc.h is missing the alloca function
# declaration. This is known to be a problem with Mingw.
# If we compiled without the function declaration, it
# would work but we would get a warning message from gcc.
# If we add the function declaration ourselves, it
# would not compile correctly because the _alloca
# function expects the argument to be passed in a
# register and not on the stack. Instead, we just
# call it from inline asm code.

echo "$as_me:$LINENO: checking for alloca declaration in malloc.h" >&5
echo $ECHO_N "checking for alloca declaration in malloc.h... $ECHO_C" >&6
if test "${tcl_cv_malloc_decl_alloca+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#include <malloc.h>

int
main ()
{

  size_t arg = 0;
  void* ptr;
  ptr = alloca;
  ptr = alloca(arg);

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_malloc_decl_alloca=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_malloc_decl_alloca=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_malloc_decl_alloca" >&5
echo "${ECHO_T}$tcl_cv_malloc_decl_alloca" >&6
if test "$tcl_cv_malloc_decl_alloca" = "no" &&
   test "${GCC}" = "yes" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_ALLOCA_GCC_INLINE 1
_ACEOF

fi

# See if the compiler supports casting to a union type.
# This is used to stop gcc from printing a compiler
# warning when initializing a union member.

echo "$as_me:$LINENO: checking for cast to union support" >&5
echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
if test "${tcl_cv_cast_to_union+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{

  union foo { int i; double d; };
  union foo f = (union foo) (int) 0;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_cast_to_union=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_cast_to_union=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
if test "$tcl_cv_cast_to_union" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_CAST_TO_UNION 1
_ACEOF

fi

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
if test "${tcl_cv_findex_enums+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main ()
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_findex_enums=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_findex_enums=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
echo "${ECHO_T}$tcl_cv_findex_enums" >&6
if test "$tcl_cv_findex_enums" = "no"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_FINDEX_ENUMS 1
_ACEOF

fi

# See if MWMO_ALERTABLE is missing from winuser.h
# This is known to be a problem with Mingw.

echo "$as_me:$LINENO: checking for MWMO_ALERTABLE in winuser.h" >&5
echo $ECHO_N "checking for MWMO_ALERTABLE in winuser.h... $ECHO_C" >&6
if test "${tcl_cv_mwmo_alertable+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main ()
{

  int i = MWMO_ALERTABLE;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_mwmo_alertable=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_mwmo_alertable=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_mwmo_alertable" >&5
echo "${ECHO_T}$tcl_cv_mwmo_alertable" >&6
if test "$tcl_cv_mwmo_alertable" = "no"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_MWMO_ALERTABLE 1
_ACEOF

fi

# See if the compiler supports intrinsics.

echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5
echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6
if test "${tcl_cv_intrinsics+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <intrin.h>

int
main ()
{

  __cpuidex(0,0,0);

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
  (eval $ac_link) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest$ac_exeext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_intrinsics=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_intrinsics=no
fi
rm -f conftest.err conftest.$ac_objext \
      conftest$ac_exeext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5
echo "${ECHO_T}$tcl_cv_intrinsics" >&6
if test "$tcl_cv_intrinsics" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_INTRIN_H 1
_ACEOF

fi

# See if the <wspiapi.h> header file is present

echo "$as_me:$LINENO: checking for wspiapi.h" >&5
echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
if test "${tcl_have_wspiapi_h+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#include <wspiapi.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_have_wspiapi_h=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_have_wspiapi_h=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_have_wspiapi_h" >&5
echo "${ECHO_T}$tcl_have_wspiapi_h" >&6
if test "$tcl_have_wspiapi_h" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_WSPIAPI_H 1
_ACEOF

fi

#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------











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







3038
3039
3040
3041
3042
3043
3044



















































































































































































































































































































































































































































































































































































































































































































































3045
3046
3047
3048
3049
3050
3051
else
  echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6
  SET_MAKE="MAKE=${MAKE-make}"
fi





















































































































































































































































































































































































































































































































































































































































































































































#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------




4040
4041
4042
4043
4044
4045
4046

















































































4047
4048
4049
4050
4051
4052
4053


    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"


















































































    # Check for a bug in gcc's windres that causes the
    # compile to fail when a Windows native path is
    # passed into windres. The mingw toolchain requires
    # Windows native paths while Cygwin should work
    # with both. Avoid the bug by passing a POSIX
    # path when using the Cygwin toolchain.







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







3317
3318
3319
3320
3321
3322
3323
3324
3325
3326
3327
3328
3329
3330
3331
3332
3333
3334
3335
3336
3337
3338
3339
3340
3341
3342
3343
3344
3345
3346
3347
3348
3349
3350
3351
3352
3353
3354
3355
3356
3357
3358
3359
3360
3361
3362
3363
3364
3365
3366
3367
3368
3369
3370
3371
3372
3373
3374
3375
3376
3377
3378
3379
3380
3381
3382
3383
3384
3385
3386
3387
3388
3389
3390
3391
3392
3393
3394
3395
3396
3397
3398
3399
3400
3401
3402
3403
3404
3405
3406
3407
3408
3409
3410
3411


    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"

    if test "$GCC" = "yes"; then

      echo "$as_me:$LINENO: checking for cross-compile version of gcc" >&5
echo $ECHO_N "checking for cross-compile version of gcc... $ECHO_C" >&6
if test "${ac_cv_cross+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

	    #ifndef __WIN32__
		#error cross-compiler
	    #endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  ac_cv_cross=no
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

ac_cv_cross=yes
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $ac_cv_cross" >&5
echo "${ECHO_T}$ac_cv_cross" >&6

      if test "$ac_cv_cross" = "yes"; then
	case "$do64bit" in
	    amd64|x64|yes)
		CC="x86_64-w64-mingw32-gcc"
		LD="x86_64-w64-mingw32-ld"
		AR="x86_64-w64-mingw32-ar"
		RANLIB="x86_64-w64-mingw32-ranlib"
		RC="x86_64-w64-mingw32-windres"
	    ;;
	    *)
		CC="i686-w64-mingw32-gcc"
		LD="i686-w64-mingw32-ld"
		AR="i686-w64-mingw32-ar"
		RANLIB="i686-w64-mingw32-ranlib"
		RC="i686-w64-mingw32-windres"
	    ;;
	esac
      fi
    fi

    # Check for a bug in gcc's windres that causes the
    # compile to fail when a Windows native path is
    # passed into windres. The mingw toolchain requires
    # Windows native paths while Cygwin should work
    # with both. Avoid the bug by passing a POSIX
    # path when using the Cygwin toolchain.
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162

4163
4164



4165
4166
4167
4168
4169



4170
4171



4172







4173

4174



4175
4176



4177
4178

4179
4180
4181
4182
4183


4184
4185
4186
4187
4188

4189







4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
echo "${ECHO_T}yes" >&6
	    CYGPATH=echo
	fi
	conftest=
	cyg_conftest=
    fi

    echo "$as_me:$LINENO: checking for Cygwin version of gcc" >&5
echo $ECHO_N "checking for Cygwin version of gcc... $ECHO_C" >&6
if test "${ac_cv_cygwin+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

    #ifdef __CYGWIN__
    #error cygwin
    #endif

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  ac_cv_cygwin=no
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

ac_cv_cygwin=yes
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $ac_cv_cygwin" >&5
echo "${ECHO_T}$ac_cv_cygwin" >&6
    if test "$ac_cv_cygwin" = "yes" ; then
    { echo "$as_me:$LINENO: WARNING: Compiling under Cygwin is not currently supported.
If you are not sure you want this, see the README
file for information about building with Mingw." >&5
echo "$as_me: WARNING: Compiling under Cygwin is not currently supported.
If you are not sure you want this, see the README
file for information about building with Mingw." >&2;}
    fi
    if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
        DEPARG='"$<"'
    else
        DEPARG='"$(shell $(CYGPATH) $<)"'
    fi

    # set various compiler flags depending on whether we are using gcc or cl

    echo "$as_me:$LINENO: checking compiler flags" >&5
echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
    if test "${GCC}" = "yes" ; then
	SHLIB_LD=""
	SHLIB_LD_LIBS='${LIBS}'
	LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32"
	# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
	LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"

	STLIB_LD='${AR} cr'
	RC_OUT=-o



	RC_TYPE=
	RC_INCLUDE=--include
	RC_DEFINE=--define
	RES=res.o
	MAKE_LIB="\${STLIB_LD} \$@"



	POST_MAKE_LIB="\${RANLIB} \$@"
	MAKE_EXE="\${CC} -o \$@"



	LIBPREFIX="lib"









	extra_cflags="-pipe"



	extra_ldflags="-pipe"




	if test "$ac_cv_cygwin" = "yes"; then
	  touch ac$$.c

	  if ${CC} -c -mwin32 ac$$.c >/dev/null 2>&1; then
	    case "$extra_cflags" in
	      *-mwin32*) ;;
	      *) extra_cflags="-mwin32 $extra_cflags" ;;
	    esac


	    case "$extra_ldflags" in
	      *-mwin32*) ;;
	      *) extra_ldflags="-mwin32 $extra_ldflags" ;;
	    esac
	  fi

	  rm -f ac$$.o ac$$.c







	fi

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
    echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
if test "${ac_cv_municode+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

    #include <windows.h>
    int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}

int
main ()
{

  ;
  return 0;







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







<
<

|
|
|
|
|
>
|
|
>
>
>
|
|
|
|
|
>
>
>
|
<
>
>
>
|
>
>
>
>
>
>
>
|
>
|
>
>
>
|
|
>
>
>
|
|
>
|
<
|
<
|
>
>
|
|
<
<
|
>
|
>
>
>
>
>
>
>



|











|
|







3432
3433
3434
3435
3436
3437
3438


































































3439
3440
3441
3442
3443
3444
3445
3446


3447
3448
3449
3450
3451
3452
3453
3454
3455
3456
3457
3458
3459
3460
3461
3462
3463
3464
3465
3466
3467

3468
3469
3470
3471
3472
3473
3474
3475
3476
3477
3478
3479
3480
3481
3482
3483
3484
3485
3486
3487
3488
3489
3490
3491
3492
3493

3494

3495
3496
3497
3498
3499


3500
3501
3502
3503
3504
3505
3506
3507
3508
3509
3510
3511
3512
3513
3514
3515
3516
3517
3518
3519
3520
3521
3522
3523
3524
3525
3526
3527
3528
3529
3530
3531
3532
3533
echo "${ECHO_T}yes" >&6
	    CYGPATH=echo
	fi
	conftest=
	cyg_conftest=
    fi



































































    if test "$CYGPATH" = "echo"; then
        DEPARG='"$<"'
    else
        DEPARG='"$(shell $(CYGPATH) $<)"'
    fi

    # set various compiler flags depending on whether we are using gcc or cl



    if test "${GCC}" = "yes" ; then
	echo "$as_me:$LINENO: checking for mingw32 version of gcc" >&5
echo $ECHO_N "checking for mingw32 version of gcc... $ECHO_C" >&6
if test "${ac_cv_win32+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

		#ifdef __WIN32__
		    #error win32
		#endif

int
main ()
{


  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then

  ac_cv_win32=no

else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

ac_cv_win32=yes


fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $ac_cv_win32" >&5
echo "${ECHO_T}$ac_cv_win32" >&6
	if test "$ac_cv_win32" != "yes"; then
	    { { echo "$as_me:$LINENO: error: ${CC} cannot produce win32 executables." >&5
echo "$as_me: error: ${CC} cannot produce win32 executables." >&2;}
   { (exit 1); exit 1; }; }
	fi

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
	echo "$as_me:$LINENO: checking for working -municode linker flag" >&5
echo $ECHO_N "checking for working -municode linker flag... $ECHO_C" >&6
if test "${ac_cv_municode+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

	#include <windows.h>
	int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}

int
main ()
{

  ;
  return 0;
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256























4257
4258
4259
4260
4261
4262
4263
fi
rm -f conftest.err conftest.$ac_objext \
      conftest$ac_exeext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
echo "${ECHO_T}$ac_cv_municode" >&6
    CFLAGS=$hold_cflags
    if test "$ac_cv_municode" = "yes" ; then
	extra_ldflags="$extra_ldflags -municode"
    else
	extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
    fi
























	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"







|
|
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







3564
3565
3566
3567
3568
3569
3570
3571
3572
3573
3574
3575
3576
3577
3578
3579
3580
3581
3582
3583
3584
3585
3586
3587
3588
3589
3590
3591
3592
3593
3594
3595
3596
3597
3598
3599
3600
3601
3602
3603
3604
3605
3606
fi
rm -f conftest.err conftest.$ac_objext \
      conftest$ac_exeext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $ac_cv_municode" >&5
echo "${ECHO_T}$ac_cv_municode" >&6
	CFLAGS=$hold_cflags
	if test "$ac_cv_municode" = "yes" ; then
	    extra_ldflags="$extra_ldflags -municode"
	else
	    extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
	fi
    fi

    echo "$as_me:$LINENO: checking compiler flags" >&5
echo $ECHO_N "checking compiler flags... $ECHO_C" >&6
    if test "${GCC}" = "yes" ; then
	SHLIB_LD=""
	SHLIB_LD_LIBS='${LIBS}'
	LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32"
	# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
	LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
	STLIB_LD='${AR} cr'
	RC_OUT=-o
	RC_TYPE=
	RC_INCLUDE=--include
	RC_DEFINE=--define
	RES=res.o
	MAKE_LIB="\${STLIB_LD} \$@"
	POST_MAKE_LIB="\${RANLIB} \$@"
	MAKE_EXE="\${CC} -o \$@"
	LIBPREFIX="lib"

	extra_ldflags="$extra_ldflags -pipe"
	extra_cflags="$extra_cflags -pipe"

	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            echo "$as_me:$LINENO: result: using static flags" >&5
echo "${ECHO_T}using static flags" >&6
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
		cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

			#ifdef _WIN64
			#error 64-bit
			#endif

int
main ()
{

  ;
  return 0;







|
|
|







3683
3684
3685
3686
3687
3688
3689
3690
3691
3692
3693
3694
3695
3696
3697
3698
3699
		cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

		    #ifndef _WIN64
			#error 32-bit
		    #endif

int
main ()
{

  ;
  return 0;
4374
4375
4376
4377
4378
4379
4380
4381
4382
4383
4384
4385
4386
4387
4388
4389
4390
4391
4392
4393
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_win_64bit=no
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_win_64bit=yes

fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
		if test "$tcl_win_64bit" = "yes" ; then
			do64bit=amd64
			MACHINE="AMD64"
			echo "$as_me:$LINENO: result:    Using 64-bit $MACHINE mode" >&5







|




|







3717
3718
3719
3720
3721
3722
3723
3724
3725
3726
3727
3728
3729
3730
3731
3732
3733
3734
3735
3736
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_win_64bit=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_win_64bit=no

fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext
		if test "$tcl_win_64bit" = "yes" ; then
			do64bit=amd64
			MACHINE="AMD64"
			echo "$as_me:$LINENO: result:    Using 64-bit $MACHINE mode" >&5
4686
4687
4688
4689
4690
4691
4692





























































































































































































































































































4693
4694
4695
4696
4697
4698
4699

    if test "$do64bit" != "no" ; then
	cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_DO64BIT 1
_ACEOF

    fi






























































































































































































































































































    # DL_LIBS is empty, but then we match the Unix version












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







4029
4030
4031
4032
4033
4034
4035
4036
4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
4058
4059
4060
4061
4062
4063
4064
4065
4066
4067
4068
4069
4070
4071
4072
4073
4074
4075
4076
4077
4078
4079
4080
4081
4082
4083
4084
4085
4086
4087
4088
4089
4090
4091
4092
4093
4094
4095
4096
4097
4098
4099
4100
4101
4102
4103
4104
4105
4106
4107
4108
4109
4110
4111
4112
4113
4114
4115
4116
4117
4118
4119
4120
4121
4122
4123
4124
4125
4126
4127
4128
4129
4130
4131
4132
4133
4134
4135
4136
4137
4138
4139
4140
4141
4142
4143
4144
4145
4146
4147
4148
4149
4150
4151
4152
4153
4154
4155
4156
4157
4158
4159
4160
4161
4162
4163
4164
4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
4213
4214
4215
4216
4217
4218
4219
4220
4221
4222
4223
4224
4225
4226
4227
4228
4229
4230
4231
4232
4233
4234
4235
4236
4237
4238
4239
4240
4241
4242
4243
4244
4245
4246
4247
4248
4249
4250
4251
4252
4253
4254
4255
4256
4257
4258
4259
4260
4261
4262
4263
4264
4265
4266
4267
4268
4269
4270
4271
4272
4273
4274
4275
4276
4277
4278
4279
4280
4281
4282
4283
4284
4285
4286
4287
4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327

    if test "$do64bit" != "no" ; then
	cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_DO64BIT 1
_ACEOF

    fi

    if test "${GCC}" = "yes" ; then
	echo "$as_me:$LINENO: checking for SEH support in compiler" >&5
echo $ECHO_N "checking for SEH support in compiler... $ECHO_C" >&6
if test "${tcl_cv_seh+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  if test "$cross_compiling" = yes; then
  tcl_cv_seh=no
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

	    #define WIN32_LEAN_AND_MEAN
	    #include <windows.h>
	    #undef WIN32_LEAN_AND_MEAN

	    int main(int argc, char** argv) {
		int a, b = 0;
		__try {
		    a = 666 / b;
		}
		__except (EXCEPTION_EXECUTE_HANDLER) {
		    return 0;
		}
		return 1;
	    }

_ACEOF
rm -f conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
  (eval $ac_link) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } && { ac_try='./conftest$ac_exeext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_seh=yes
else
  echo "$as_me: program exited with status $ac_status" >&5
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

( exit $ac_status )
tcl_cv_seh=no
fi
rm -f core *.core gmon.out bb.out conftest$ac_exeext conftest.$ac_objext conftest.$ac_ext
fi

fi
echo "$as_me:$LINENO: result: $tcl_cv_seh" >&5
echo "${ECHO_T}$tcl_cv_seh" >&6
	if test "$tcl_cv_seh" = "no" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_SEH 1
_ACEOF

	fi

	#
	# Check to see if the excpt.h include file provided contains the
	# definition for EXCEPTION_DISPOSITION; if not, which is the case
	# with Cygwin's version as of 2002-04-10, define it to be int,
	# sufficient for getting the current code to work.
	#
	echo "$as_me:$LINENO: checking for EXCEPTION_DISPOSITION support in include files" >&5
echo $ECHO_N "checking for EXCEPTION_DISPOSITION support in include files... $ECHO_C" >&6
if test "${tcl_cv_eh_disposition+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#	    define WIN32_LEAN_AND_MEAN
#	    include <windows.h>
#	    undef WIN32_LEAN_AND_MEAN

int
main ()
{

		EXCEPTION_DISPOSITION x;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_eh_disposition=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_eh_disposition=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_eh_disposition" >&5
echo "${ECHO_T}$tcl_cv_eh_disposition" >&6
	if test "$tcl_cv_eh_disposition" = "no" ; then

cat >>confdefs.h <<\_ACEOF
#define EXCEPTION_DISPOSITION int
_ACEOF

	fi

	# Check to see if winnt.h defines CHAR, SHORT, and LONG
	# even if VOID has already been #defined. The win32api
	# used by mingw and cygwin is known to do this.

	echo "$as_me:$LINENO: checking for winnt.h that ignores VOID define" >&5
echo $ECHO_N "checking for winnt.h that ignores VOID define... $ECHO_C" >&6
if test "${tcl_cv_winnt_ignore_void+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

		#define VOID void
		#define WIN32_LEAN_AND_MEAN
		#include <windows.h>
		#undef WIN32_LEAN_AND_MEAN

int
main ()
{

		CHAR c;
		SHORT s;
		LONG l;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_winnt_ignore_void=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_winnt_ignore_void=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_winnt_ignore_void" >&5
echo "${ECHO_T}$tcl_cv_winnt_ignore_void" >&6
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_WINNT_IGNORE_VOID 1
_ACEOF

	fi

	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	echo "$as_me:$LINENO: checking for cast to union support" >&5
echo $ECHO_N "checking for cast to union support... $ECHO_C" >&6
if test "${tcl_cv_cast_to_union+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

int
main ()
{

		  union foo { int i; double d; };
		  union foo f = (union foo) (int) 0;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_cast_to_union=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_cast_to_union=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_cast_to_union" >&5
echo "${ECHO_T}$tcl_cv_cast_to_union" >&6
	if test "$tcl_cv_cast_to_union" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_CAST_TO_UNION 1
_ACEOF

	fi
    fi

    # DL_LIBS is empty, but then we match the Unix version





5024
5025
5026
5027
5028
5029
5030

































































































































































































































































































5031
5032
5033
5034
5035
5036
5037
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi


































































































































































































































































































#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option.  This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
#--------------------------------------------------------------------









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







4652
4653
4654
4655
4656
4657
4658
4659
4660
4661
4662
4663
4664
4665
4666
4667
4668
4669
4670
4671
4672
4673
4674
4675
4676
4677
4678
4679
4680
4681
4682
4683
4684
4685
4686
4687
4688
4689
4690
4691
4692
4693
4694
4695
4696
4697
4698
4699
4700
4701
4702
4703
4704
4705
4706
4707
4708
4709
4710
4711
4712
4713
4714
4715
4716
4717
4718
4719
4720
4721
4722
4723
4724
4725
4726
4727
4728
4729
4730
4731
4732
4733
4734
4735
4736
4737
4738
4739
4740
4741
4742
4743
4744
4745
4746
4747
4748
4749
4750
4751
4752
4753
4754
4755
4756
4757
4758
4759
4760
4761
4762
4763
4764
4765
4766
4767
4768
4769
4770
4771
4772
4773
4774
4775
4776
4777
4778
4779
4780
4781
4782
4783
4784
4785
4786
4787
4788
4789
4790
4791
4792
4793
4794
4795
4796
4797
4798
4799
4800
4801
4802
4803
4804
4805
4806
4807
4808
4809
4810
4811
4812
4813
4814
4815
4816
4817
4818
4819
4820
4821
4822
4823
4824
4825
4826
4827
4828
4829
4830
4831
4832
4833
4834
4835
4836
4837
4838
4839
4840
4841
4842
4843
4844
4845
4846
4847
4848
4849
4850
4851
4852
4853
4854
4855
4856
4857
4858
4859
4860
4861
4862
4863
4864
4865
4866
4867
4868
4869
4870
4871
4872
4873
4874
4875
4876
4877
4878
4879
4880
4881
4882
4883
4884
4885
4886
4887
4888
4889
4890
4891
4892
4893
4894
4895
4896
4897
4898
4899
4900
4901
4902
4903
4904
4905
4906
4907
4908
4909
4910
4911
4912
4913
4914
4915
4916
4917
4918
4919
4920
4921
4922
4923
4924
4925
4926
4927
4928
4929
4930
4931
4932
4933
4934
4935
4936
4937
4938
4939
4940
4941
4942
4943
4944
4945
4946
4947
4948
4949
4950
4951
4952
4953
4954
#define uintptr_t $tcl_cv_uintptr_t
_ACEOF

    fi

fi


#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
if test "${tcl_cv_findex_enums+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main ()
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_findex_enums=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_findex_enums=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
echo "${ECHO_T}$tcl_cv_findex_enums" >&6
if test "$tcl_cv_findex_enums" = "no"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_FINDEX_ENUMS 1
_ACEOF

fi

# See if the compiler supports intrinsics.

echo "$as_me:$LINENO: checking for intrinsics support in compiler" >&5
echo $ECHO_N "checking for intrinsics support in compiler... $ECHO_C" >&6
if test "${tcl_cv_intrinsics+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <intrin.h>

int
main ()
{

  __cpuidex(0,0,0);

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
  (eval $ac_link) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest$ac_exeext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_intrinsics=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_intrinsics=no
fi
rm -f conftest.err conftest.$ac_objext \
      conftest$ac_exeext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_intrinsics" >&5
echo "${ECHO_T}$tcl_cv_intrinsics" >&6
if test "$tcl_cv_intrinsics" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_INTRIN_H 1
_ACEOF

fi

# See if the <wspiapi.h> header file is present

echo "$as_me:$LINENO: checking for wspiapi.h" >&5
echo $ECHO_N "checking for wspiapi.h... $ECHO_C" >&6
if test "${tcl_cv_wspiapi_h+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#include <wspiapi.h>

int
main ()
{

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_wspiapi_h=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_wspiapi_h=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_wspiapi_h" >&5
echo "${ECHO_T}$tcl_cv_wspiapi_h" >&6
if test "$tcl_cv_wspiapi_h" = "yes"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_WSPIAPI_H 1
_ACEOF

fi

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

echo "$as_me:$LINENO: checking for FINDEX_INFO_LEVELS in winbase.h" >&5
echo $ECHO_N "checking for FINDEX_INFO_LEVELS in winbase.h... $ECHO_C" >&6
if test "${tcl_cv_findex_enums+set}" = set; then
  echo $ECHO_N "(cached) $ECHO_C" >&6
else
  cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h.  */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h.  */

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int
main ()
{

  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;

  ;
  return 0;
}
_ACEOF
rm -f conftest.$ac_objext
if { (eval echo "$as_me:$LINENO: \"$ac_compile\"") >&5
  (eval $ac_compile) 2>conftest.er1
  ac_status=$?
  grep -v '^ *+' conftest.er1 >conftest.err
  rm -f conftest.er1
  cat conftest.err >&5
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); } &&
	 { ac_try='test -z "$ac_c_werror_flag"
			 || test ! -s conftest.err'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; } &&
	 { ac_try='test -s conftest.$ac_objext'
  { (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
  (eval $ac_try) 2>&5
  ac_status=$?
  echo "$as_me:$LINENO: \$? = $ac_status" >&5
  (exit $ac_status); }; }; then
  tcl_cv_findex_enums=yes
else
  echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5

tcl_cv_findex_enums=no
fi
rm -f conftest.err conftest.$ac_objext conftest.$ac_ext

fi
echo "$as_me:$LINENO: result: $tcl_cv_findex_enums" >&5
echo "${ECHO_T}$tcl_cv_findex_enums" >&6
if test "$tcl_cv_findex_enums" = "no"; then

cat >>confdefs.h <<\_ACEOF
#define HAVE_NO_FINDEX_ENUMS 1
_ACEOF

fi

#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option.  This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
#--------------------------------------------------------------------


5045
5046
5047
5048
5049
5050
5051





5052
5053
5054
5055
5056
5057
5058
5059
5060
5061
5062
5063
5064
5065
5066
5067
5068
5069
5070
5071
5072
5073
5074
5075

5076
5077
5078
5079
5080
5081
5082

5083
5084
5085
5086

5087
5088
5089
5090
5091
5092
5093
5094
  tcl_ok=no
fi;
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
	DBGX=""





	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6

	cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_OPTIMIZED 1
_ACEOF

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	DBGX=g
	if test "$tcl_ok" = "yes"; then
	    echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
echo "${ECHO_T}yes (standard debugging)" >&6
	fi
    fi


    cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_DEBUG 1
_ACEOF


    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

	cat >>confdefs.h <<\_ACEOF
#define TCL_MEM_DEBUG 1
_ACEOF

    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then

	cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_DEBUG 1
_ACEOF


	cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_STATS 1
_ACEOF

    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then







>
>
>
>
>


















<
<
<

<

>
|






>
|



>
|







4962
4963
4964
4965
4966
4967
4968
4969
4970
4971
4972
4973
4974
4975
4976
4977
4978
4979
4980
4981
4982
4983
4984
4985
4986
4987
4988
4989
4990
4991



4992

4993
4994
4995
4996
4997
4998
4999
5000
5001
5002
5003
5004
5005
5006
5007
5008
5009
5010
5011
5012
5013
5014
5015
  tcl_ok=no
fi;
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
	DBGX=""

cat >>confdefs.h <<\_ACEOF
#define NDEBUG 1
_ACEOF

	echo "$as_me:$LINENO: result: no" >&5
echo "${ECHO_T}no" >&6

	cat >>confdefs.h <<\_ACEOF
#define TCL_CFG_OPTIMIZED 1
_ACEOF

    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	DBGX=g
	if test "$tcl_ok" = "yes"; then
	    echo "$as_me:$LINENO: result: yes (standard debugging)" >&5
echo "${ECHO_T}yes (standard debugging)" >&6
	fi
    fi







    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then

cat >>confdefs.h <<\_ACEOF
#define TCL_MEM_DEBUG 1
_ACEOF

    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then

cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_DEBUG 1
_ACEOF


cat >>confdefs.h <<\_ACEOF
#define TCL_COMPILE_STATS 1
_ACEOF

    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then

Changes to win/configure.in.

64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314

#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------

AC_PROG_MAKE_SET

#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

dnl Currently AC_CYGWIN is disabled since it invokes AC_CANONICAL_HOST
dnl under autoconf 2.5X.
dnl
dnl AC_CYGWIN

AC_CACHE_CHECK(for SEH support in compiler,
    tcl_cv_seh,
AC_TRY_RUN([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

int main(int argc, char** argv) {
    int a, b = 0;
    __try {
        a = 666 / b;
    }
    __except (EXCEPTION_EXECUTE_HANDLER) {
        return 0;
    }
    return 1;
}
],
        tcl_cv_seh=yes,
        tcl_cv_seh=no,
        tcl_cv_seh=no)
)
if test "$tcl_cv_seh" = "no" ; then
    AC_DEFINE(HAVE_NO_SEH, 1,
            [Defined when mingw does not support SEH])
fi

#
# Check to see if the excpt.h include file provided contains the
# definition for EXCEPTION_DISPOSITION; if not, which is the case
# with Cygwin's version as of 2002-04-10, define it to be int,
# sufficient for getting the current code to work.
#
AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files,
    tcl_cv_eh_disposition,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
],
[
  EXCEPTION_DISPOSITION x;
],
        tcl_cv_eh_disposition=yes,
        tcl_cv_eh_disposition=no)
)
if test "$tcl_cv_eh_disposition" = "no" ; then
    AC_DEFINE(EXCEPTION_DISPOSITION, int,
            [Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
fi


# Check to see if the winsock2.h include file provided contains
# typedefs like LPFN_ACCEPT and friends.
#
AC_CACHE_CHECK(for LPFN_ACCEPT support in winsock2.h,
    tcl_cv_lpfn_decls,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <winsock2.h>
],
[
  LPFN_ACCEPT accept;
],
        tcl_cv_lpfn_decls=yes,
        tcl_cv_lpfn_decls=no)
)
if test "$tcl_cv_lpfn_decls" = "no" ; then
    AC_DEFINE(HAVE_NO_LPFN_DECLS, 1,
            [Defined when cygwin/mingw does not support LPFN_ACCEPT and friends.])
fi

# Check to see if winnt.h defines CHAR, SHORT, and LONG
# even if VOID has already been #defined. The win32api
# used by mingw and cygwin is known to do this.

AC_CACHE_CHECK(for winnt.h that ignores VOID define,
    tcl_cv_winnt_ignore_void,
AC_TRY_COMPILE([
#define VOID void
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
],
[
  CHAR c;
  SHORT s;
  LONG l;
],
        tcl_cv_winnt_ignore_void=yes,
        tcl_cv_winnt_ignore_void=no)
)
if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
    AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
            [Defined when cygwin/mingw ignores VOID define in winnt.h])
fi

# Check to see if malloc.h is missing the alloca function
# declaration. This is known to be a problem with Mingw.
# If we compiled without the function declaration, it
# would work but we would get a warning message from gcc.
# If we add the function declaration ourselves, it
# would not compile correctly because the _alloca
# function expects the argument to be passed in a
# register and not on the stack. Instead, we just
# call it from inline asm code.

AC_CACHE_CHECK(for alloca declaration in malloc.h,
    tcl_cv_malloc_decl_alloca,
AC_TRY_COMPILE([
#include <malloc.h>
],
[
  size_t arg = 0;
  void* ptr;
  ptr = alloca;
  ptr = alloca(arg);
],
        tcl_cv_malloc_decl_alloca=yes,
        tcl_cv_malloc_decl_alloca=no)
)
if test "$tcl_cv_malloc_decl_alloca" = "no" &&
   test "${GCC}" = "yes" ; then
    AC_DEFINE(HAVE_ALLOCA_GCC_INLINE, 1,
            [Defined when gcc should use inline ASM to call alloca.])
fi

# See if the compiler supports casting to a union type.
# This is used to stop gcc from printing a compiler
# warning when initializing a union member.

AC_CACHE_CHECK(for cast to union support,
    tcl_cv_cast_to_union,
AC_TRY_COMPILE([],
[
  union foo { int i; double d; };
  union foo f = (union foo) (int) 0;
],
        tcl_cv_cast_to_union=yes,
        tcl_cv_cast_to_union=no)
)
if test "$tcl_cv_cast_to_union" = "yes"; then
    AC_DEFINE(HAVE_CAST_TO_UNION, 1,
            [Defined when compiler supports casting to union type.])
fi

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
    tcl_cv_findex_enums,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
],
[
  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;
],
        tcl_cv_findex_enums=yes,
        tcl_cv_findex_enums=no)
)
if test "$tcl_cv_findex_enums" = "no"; then
    AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
            [Defined when enums are missing from winbase.h])
fi

# See if MWMO_ALERTABLE is missing from winuser.h
# This is known to be a problem with Mingw.

AC_CACHE_CHECK(for MWMO_ALERTABLE in winuser.h,
    tcl_cv_mwmo_alertable,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
],
[
  int i = MWMO_ALERTABLE;
],
        tcl_cv_mwmo_alertable=yes,
        tcl_cv_mwmo_alertable=no)
)
if test "$tcl_cv_mwmo_alertable" = "no"; then
    AC_DEFINE(HAVE_NO_MWMO_ALERTABLE, 1,
            [Defined when MWMO_ALERTABLE is missing from winuser.h])
fi

# See if the compiler supports intrinsics.

AC_CACHE_CHECK(for intrinsics support in compiler,
    tcl_cv_intrinsics,
AC_TRY_LINK([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <intrin.h>
],
[
  __cpuidex(0,0,0);
],
        tcl_cv_intrinsics=yes,
        tcl_cv_intrinsics=no)
)
if test "$tcl_cv_intrinsics" = "yes"; then
    AC_DEFINE(HAVE_INTRIN_H, 1,
            [Defined when the compilers supports intrinsics])
fi

# See if the <wspiapi.h> header file is present    

AC_CACHE_CHECK(for wspiapi.h,
    tcl_have_wspiapi_h,
AC_TRY_COMPILE([
#include <wspiapi.h>
], [],
        tcl_have_wspiapi_h=yes,
        tcl_have_wspiapi_h=no)
)
if test "$tcl_have_wspiapi_h" = "yes"; then
    AC_DEFINE(HAVE_WSPIAPI_H, 1,
            [Defined when wspiapi.h exists])
fi

#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------

AC_OBJEXT
AC_EXEEXT








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







64
65
66
67
68
69
70













































































































































































































































71
72
73
74
75
76
77

#--------------------------------------------------------------------
# Checks to see if the make program sets the $MAKE variable.
#--------------------------------------------------------------------

AC_PROG_MAKE_SET














































































































































































































































#--------------------------------------------------------------------
# Determines the correct binary file extension (.o, .obj, .exe etc.)
#--------------------------------------------------------------------

AC_OBJEXT
AC_EXEEXT

400
401
402
403
404
405
406























































































407
408
409
410
411
412
413
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi
])























































































#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option.  This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
#--------------------------------------------------------------------

SC_ENABLE_SYMBOLS







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







163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
	    test "$tcl_ok" = yes && break; fi
    done])
    if test "$tcl_cv_uintptr_t" != none; then
	AC_DEFINE_UNQUOTED([uintptr_t], [$tcl_cv_uintptr_t], [Unsigned integer
	   type wide enough to hold a pointer.])
    fi
])

#--------------------------------------------------------------------
# Perform additinal compiler tests.
#--------------------------------------------------------------------

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
    tcl_cv_findex_enums,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
],
[
  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;
],
        tcl_cv_findex_enums=yes,
        tcl_cv_findex_enums=no)
)
if test "$tcl_cv_findex_enums" = "no"; then
    AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
            [Defined when enums are missing from winbase.h])
fi

# See if the compiler supports intrinsics.

AC_CACHE_CHECK(for intrinsics support in compiler,
    tcl_cv_intrinsics,
AC_TRY_LINK([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
#include <intrin.h>
],
[
  __cpuidex(0,0,0);
],
        tcl_cv_intrinsics=yes,
        tcl_cv_intrinsics=no)
)
if test "$tcl_cv_intrinsics" = "yes"; then
    AC_DEFINE(HAVE_INTRIN_H, 1,
            [Defined when the compilers supports intrinsics])
fi

# See if the <wspiapi.h> header file is present    

AC_CACHE_CHECK(for wspiapi.h,
    tcl_cv_wspiapi_h,
AC_TRY_COMPILE([
#include <wspiapi.h>
], [],
        tcl_cv_wspiapi_h=yes,
        tcl_cv_wspiapi_h=no)
)
if test "$tcl_cv_wspiapi_h" = "yes"; then
    AC_DEFINE(HAVE_WSPIAPI_H, 1,
            [Defined when wspiapi.h exists])
fi

# See if declarations like FINDEX_INFO_LEVELS are
# missing from winbase.h. This is known to be
# a problem with VC++ 5.2.

AC_CACHE_CHECK(for FINDEX_INFO_LEVELS in winbase.h,
    tcl_cv_findex_enums,
AC_TRY_COMPILE([
#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN
],
[
  FINDEX_INFO_LEVELS i;
  FINDEX_SEARCH_OPS j;
],
        tcl_cv_findex_enums=yes,
        tcl_cv_findex_enums=no)
)
if test "$tcl_cv_findex_enums" = "no"; then
    AC_DEFINE(HAVE_NO_FINDEX_ENUMS, 1,
            [Defined when enums are missing from winbase.h])
fi

#--------------------------------------------------------------------
# Set the default compiler switches based on the --enable-symbols
# option.  This macro depends on C flags, and should be called
# after SC_CONFIG_CFLAGS macro is called.
#--------------------------------------------------------------------

SC_ENABLE_SYMBOLS

Changes to win/makefile.bc.

132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
REGVERSION = 13
REGDOTVERSION = 1.3

BINROOT		= ..
!IF "$(NODEBUG)" == "1"
TMPDIRNAME	= Release
DBGX		=
SYMDEFINES	=
!ELSE
TMPDIRNAME	= Debug
#DBGX		= d
DBGX		=
SYMDEFINES	= -DTCL_CFG_DEBUG
!ENDIF
TMPDIR		= $(BINROOT)\$(TMPDIRNAME)







|







132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
REGVERSION = 13
REGDOTVERSION = 1.3

BINROOT		= ..
!IF "$(NODEBUG)" == "1"
TMPDIRNAME	= Release
DBGX		=
SYMDEFINES	= -DNDEBUG
!ELSE
TMPDIRNAME	= Debug
#DBGX		= d
DBGX		=
SYMDEFINES	= -DTCL_CFG_DEBUG
!ENDIF
TMPDIR		= $(BINROOT)\$(TMPDIRNAME)

Changes to win/rules.vc.

469
470
471
472
473
474
475
476
477
478
479

480
481
482
483
484
485
486
487


488
489
490
491
492
493
494
!if $(STATIC_BUILD)
OPTDEFINES	= $(OPTDEFINES) -DSTATIC_BUILD
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES	= $(OPTDEFINES) -DTCL_NO_DEPRECATED
!endif

!if $(DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_DEBUG
!elseif $(OPTIMIZING)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_OPTIMIZED

!endif
!if $(PROFILE)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_PROFILED
!endif
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_DO64BIT
!endif




#----------------------------------------------------------
# Locate the Tcl headers to build against
#----------------------------------------------------------

!if "$(PROJECT)" == "tcl"








|
|
|

>







|
>
>







469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
!if $(STATIC_BUILD)
OPTDEFINES	= $(OPTDEFINES) -DSTATIC_BUILD
!endif
!if $(TCL_NO_DEPRECATED)
OPTDEFINES	= $(OPTDEFINES) -DTCL_NO_DEPRECATED
!endif

!if !$(DEBUG)
OPTDEFINES	= $(OPTDEFINES) -DNDEBUG
!if $(OPTIMIZING)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_OPTIMIZED
!endif
!endif
!if $(PROFILE)
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_PROFILED
!endif
!if "$(MACHINE)" == "IA64" || "$(MACHINE)" == "AMD64"
OPTDEFINES	= $(OPTDEFINES) -DTCL_CFG_DO64BIT
!endif
!if $(VCVERSION) < 1300
OPTDEFINES	= $(OPTDEFINES) -DNO_STRTOI64
!endif

#----------------------------------------------------------
# Locate the Tcl headers to build against
#----------------------------------------------------------

!if "$(PROJECT)" == "tcl"

Changes to win/tcl.m4.

30
31
32
33
34
35
36

37


38
39
40
41
42
43
44

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.6 binaries from DIR],
	    TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
    if test ! -d $TCL_BIN_DIR; then
	AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
    fi
    if test ! -f $TCL_BIN_DIR/tclConfig.sh; then

	AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR:  perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)


    fi
    AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh)
])

#------------------------------------------------------------------------
# SC_PATH_TKCONFIG --
#







>
|
>
>







30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47

    AC_ARG_WITH(tcl, [  --with-tcl=DIR          use Tcl 8.6 binaries from DIR],
	    TCL_BIN_DIR=$withval, TCL_BIN_DIR=`cd $TCL_BIN_DIR_DEFAULT; pwd`)
    if test ! -d $TCL_BIN_DIR; then
	AC_MSG_ERROR(Tcl directory $TCL_BIN_DIR does not exist)
    fi
    if test ! -f $TCL_BIN_DIR/tclConfig.sh; then
	if test ! -f $TCL_BIN_DIR/../unix/tclConfig.sh; then
	    AC_MSG_ERROR(There is no tclConfig.sh in $TCL_BIN_DIR:  perhaps you did not specify the Tcl *build* directory (not the toplevel Tcl directory) or you forgot to configure Tcl?)
	fi
	TCL_BIN_DIR=`cd ${TCL_BIN_DIR}/../unix; pwd`
    fi
    AC_MSG_RESULT($TCL_BIN_DIR/tclConfig.sh)
])

#------------------------------------------------------------------------
# SC_PATH_TKCONFIG --
#
296
297
298
299
300
301
302

303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
    AC_MSG_CHECKING([for build with symbols])
    AC_ARG_ENABLE(symbols, [  --enable-symbols        build with debugging symbols [--disable-symbols]],    [tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
	DBGX=""

	AC_MSG_RESULT([no])

	AC_DEFINE(TCL_CFG_OPTIMIZED)
    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	DBGX=g
	if test "$tcl_ok" = "yes"; then
	    AC_MSG_RESULT([yes (standard debugging)])
	fi
    fi
    AC_SUBST(CFLAGS_DEFAULT)
    AC_SUBST(LDFLAGS_DEFAULT)
    AC_DEFINE(TCL_CFG_DEBUG)

    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
	AC_DEFINE(TCL_MEM_DEBUG)
    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
	AC_DEFINE(TCL_COMPILE_DEBUG)
	AC_DEFINE(TCL_COMPILE_STATS)
    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then
	    AC_MSG_RESULT([enabled symbols mem compile debugging])
	else
	    AC_MSG_RESULT([enabled $tcl_ok debugging])







>













<


|



|
|







299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319

320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
    AC_MSG_CHECKING([for build with symbols])
    AC_ARG_ENABLE(symbols, [  --enable-symbols        build with debugging symbols [--disable-symbols]],    [tcl_ok=$enableval], [tcl_ok=no])
# FIXME: Currently, LDFLAGS_DEFAULT is not used, it should work like CFLAGS_DEFAULT.
    if test "$tcl_ok" = "no"; then
	CFLAGS_DEFAULT='$(CFLAGS_OPTIMIZE)'
	LDFLAGS_DEFAULT='$(LDFLAGS_OPTIMIZE)'
	DBGX=""
	AC_DEFINE(NDEBUG, 1, [Is no debugging enabled?])
	AC_MSG_RESULT([no])

	AC_DEFINE(TCL_CFG_OPTIMIZED)
    else
	CFLAGS_DEFAULT='$(CFLAGS_DEBUG)'
	LDFLAGS_DEFAULT='$(LDFLAGS_DEBUG)'
	DBGX=g
	if test "$tcl_ok" = "yes"; then
	    AC_MSG_RESULT([yes (standard debugging)])
	fi
    fi
    AC_SUBST(CFLAGS_DEFAULT)
    AC_SUBST(LDFLAGS_DEFAULT)


    if test "$tcl_ok" = "mem" -o "$tcl_ok" = "all"; then
	AC_DEFINE(TCL_MEM_DEBUG, 1, [Is memory debugging enabled?])
    fi

    if test "$tcl_ok" = "compile" -o "$tcl_ok" = "all"; then
	AC_DEFINE(TCL_COMPILE_DEBUG, 1, [Is bytecode debugging enabled?])
	AC_DEFINE(TCL_COMPILE_STATS, 1, [Are bytecode statistics enabled?])
    fi

    if test "$tcl_ok" != "yes" -a "$tcl_ok" != "no"; then
	if test "$tcl_ok" = "all"; then
	    AC_MSG_RESULT([enabled symbols mem compile debugging])
	else
	    AC_MSG_RESULT([enabled $tcl_ok debugging])
407
408
409
410
411
412
413

































414
415
416
417
418
419
420
    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)

    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"


































    # Check for a bug in gcc's windres that causes the
    # compile to fail when a Windows native path is
    # passed into windres. The mingw toolchain requires
    # Windows native paths while Cygwin should work
    # with both. Avoid the bug by passing a POSIX
    # path when using the Cygwin toolchain.







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







410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
    AC_CHECK_PROG(CYGPATH, cygpath, cygpath -w, echo)

    SHLIB_SUFFIX=".dll"

    # MACHINE is IX86 for LINK, but this is used by the manifest,
    # which requires x86|amd64|ia64.
    MACHINE="X86"

    if test "$GCC" = "yes"; then

      AC_CACHE_CHECK(for cross-compile version of gcc,
	ac_cv_cross,
	AC_TRY_COMPILE([
	    #ifndef __WIN32__
		#error cross-compiler
	    #endif
	], [],
	ac_cv_cross=no,
	ac_cv_cross=yes)
      )

      if test "$ac_cv_cross" = "yes"; then
	case "$do64bit" in
	    amd64|x64|yes)
		CC="x86_64-w64-mingw32-gcc"
		LD="x86_64-w64-mingw32-ld"
		AR="x86_64-w64-mingw32-ar"
		RANLIB="x86_64-w64-mingw32-ranlib"
		RC="x86_64-w64-mingw32-windres"
	    ;;
	    *)
		CC="i686-w64-mingw32-gcc"
		LD="i686-w64-mingw32-ld"
		AR="i686-w64-mingw32-ar"
		RANLIB="i686-w64-mingw32-ranlib"
		RC="i686-w64-mingw32-windres"
	    ;;
	esac
      fi
    fi

    # Check for a bug in gcc's windres that causes the
    # compile to fail when a Windows native path is
    # passed into windres. The mingw toolchain requires
    # Windows native paths while Cygwin should work
    # with both. Avoid the bug by passing a POSIX
    # path when using the Cygwin toolchain.
433
434
435
436
437
438
439









440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457














458
459

460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
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
	    AC_MSG_RESULT([yes])
	    CYGPATH=echo
	fi
	conftest=
	cyg_conftest=
    fi










    AC_CACHE_CHECK(for Cygwin version of gcc,
        ac_cv_cygwin,
    AC_TRY_COMPILE([
    #ifdef __CYGWIN__
    #error cygwin
    #endif
    ],
    [],
        ac_cv_cygwin=no,
        ac_cv_cygwin=yes)
    )
    if test "$ac_cv_cygwin" = "yes" ; then
    AC_MSG_WARN([Compiling under Cygwin is not currently supported.
If you are not sure you want this, see the README
file for information about building with Mingw.])
    fi
    if test "$CYGPATH" = "echo" || test "$ac_cv_cygwin" = "yes"; then
        DEPARG='"$<"'














    else
        DEPARG='"$(shell $(CYGPATH) $<)"'

    fi

    # set various compiler flags depending on whether we are using gcc or cl

    AC_MSG_CHECKING([compiler flags])
    if test "${GCC}" = "yes" ; then
	SHLIB_LD=""
	SHLIB_LD_LIBS='${LIBS}'
	LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32"
	# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
	LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
	STLIB_LD='${AR} cr'
	RC_OUT=-o
	RC_TYPE=
	RC_INCLUDE=--include
	RC_DEFINE=--define
	RES=res.o
	MAKE_LIB="\${STLIB_LD} \[$]@"
	POST_MAKE_LIB="\${RANLIB} \[$]@"
	MAKE_EXE="\${CC} -o \[$]@"
	LIBPREFIX="lib"

	extra_cflags="-pipe"
	extra_ldflags="-pipe"

	if test "$ac_cv_cygwin" = "yes"; then
	  touch ac$$.c
	  if ${CC} -c -mwin32 ac$$.c >/dev/null 2>&1; then
	    case "$extra_cflags" in
	      *-mwin32*) ;;
	      *) extra_cflags="-mwin32 $extra_cflags" ;;
	    esac
	    case "$extra_ldflags" in
	      *-mwin32*) ;;
	      *) extra_ldflags="-mwin32 $extra_ldflags" ;;
	    esac
	  fi
	  rm -f ac$$.o ac$$.c
	fi

	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
    AC_CACHE_CHECK(for working -municode linker flag,
        ac_cv_municode,
    AC_TRY_LINK([
    #include <windows.h>
    int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
    ],
    [],
        ac_cv_municode=yes,
        ac_cv_municode=no)
    )
    CFLAGS=$hold_cflags
    if test "$ac_cv_municode" = "yes" ; then
	extra_ldflags="$extra_ldflags -municode"
    else
	extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
    fi

	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            AC_MSG_RESULT([using static flags])
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s\${DBGX}.exe"







>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
<
|
|
|
|
|
|
<
<
|
|
<
>
>
>
>
>
>
>
>
>
>
>
>
>
>
|
<
>
|
|
<



















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







469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490

491
492
493
494
495
496


497
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
533
534
535































536

537

538
539
540
541
542
543
544
	    AC_MSG_RESULT([yes])
	    CYGPATH=echo
	fi
	conftest=
	cyg_conftest=
    fi

    if test "$CYGPATH" = "echo"; then
        DEPARG='"$<"'
    else
        DEPARG='"$(shell $(CYGPATH) $<)"'
    fi

    # set various compiler flags depending on whether we are using gcc or cl

    if test "${GCC}" = "yes" ; then
	AC_CACHE_CHECK(for mingw32 version of gcc,
	    ac_cv_win32,
	    AC_TRY_COMPILE([
		#ifdef __WIN32__
		    #error win32
		#endif

	    ], [],
	    ac_cv_win32=no,
	    ac_cv_win32=yes)
	)
	if test "$ac_cv_win32" != "yes"; then
	    AC_MSG_ERROR([${CC} cannot produce win32 executables.])


	fi


	hold_cflags=$CFLAGS; CFLAGS="$CFLAGS -mwindows -municode -Dmain=xxmain"
	AC_CACHE_CHECK(for working -municode linker flag,
	    ac_cv_municode,
	AC_TRY_LINK([
	#include <windows.h>
	int APIENTRY wWinMain(HINSTANCE a, HINSTANCE b, LPWSTR c, int d) {return 0;}
	],
	[],
	    ac_cv_municode=yes,
	    ac_cv_municode=no)
	)
	CFLAGS=$hold_cflags
	if test "$ac_cv_municode" = "yes" ; then
	    extra_ldflags="$extra_ldflags -municode"
	else

	    extra_cflags="$extra_cflags -DTCL_BROKEN_MAINARGS"
	fi
    fi


    AC_MSG_CHECKING([compiler flags])
    if test "${GCC}" = "yes" ; then
	SHLIB_LD=""
	SHLIB_LD_LIBS='${LIBS}'
	LIBS="-lnetapi32 -lkernel32 -luser32 -ladvapi32 -lws2_32"
	# mingw needs to link ole32 and oleaut32 for [send], but MSVC doesn't
	LIBS_GUI="-lgdi32 -lcomdlg32 -limm32 -lcomctl32 -lshell32 -luuid -lole32 -loleaut32"
	STLIB_LD='${AR} cr'
	RC_OUT=-o
	RC_TYPE=
	RC_INCLUDE=--include
	RC_DEFINE=--define
	RES=res.o
	MAKE_LIB="\${STLIB_LD} \[$]@"
	POST_MAKE_LIB="\${RANLIB} \[$]@"
	MAKE_EXE="\${CC} -o \[$]@"
	LIBPREFIX="lib"
































	extra_ldflags="$extra_ldflags -pipe"

	extra_cflags="$extra_cflags -pipe"


	if test "${SHARED_BUILD}" = "0" ; then
	    # static
            AC_MSG_RESULT([using static flags])
	    runtime=
	    LIBRARIES="\${STATIC_LIBRARIES}"
	    EXESUFFIX="s\${DBGX}.exe"
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
		;;
	    ia64)
		MACHINE="IA64"
		AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		;;
	    *)
		AC_TRY_COMPILE([
			#ifdef _WIN64
			#error 64-bit
			#endif
		], [],
			tcl_win_64bit=no,
			tcl_win_64bit=yes
		)
		if test "$tcl_win_64bit" = "yes" ; then
			do64bit=amd64
			MACHINE="AMD64"
			AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		fi
		;;







|
|
|

|
|







608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
		;;
	    ia64)
		MACHINE="IA64"
		AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		;;
	    *)
		AC_TRY_COMPILE([
		    #ifndef _WIN64
			#error 32-bit
		    #endif
		], [],
			tcl_win_64bit=yes,
			tcl_win_64bit=no
		)
		if test "$tcl_win_64bit" = "yes" ; then
			do64bit=amd64
			MACHINE="AMD64"
			AC_MSG_RESULT([   Using 64-bit $MACHINE mode])
		fi
		;;
815
816
817
818
819
820
821































































































822
823
824
825
826
827
828
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi

    if test "$do64bit" != "no" ; then
	AC_DEFINE(TCL_CFG_DO64BIT)
    fi
































































































    # DL_LIBS is empty, but then we match the Unix version
    AC_SUBST(DL_LIBS)
    AC_SUBST(CFLAGS_DEBUG)
    AC_SUBST(CFLAGS_OPTIMIZE)
    AC_SUBST(CFLAGS_WARNING)
])







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







836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
	    LDFLAGS_WINDOW="-link -subsystem:windows ${lflags}"
	fi
    fi

    if test "$do64bit" != "no" ; then
	AC_DEFINE(TCL_CFG_DO64BIT)
    fi

    if test "${GCC}" = "yes" ; then
	AC_CACHE_CHECK(for SEH support in compiler,
	    tcl_cv_seh,
	AC_TRY_RUN([
	    #define WIN32_LEAN_AND_MEAN
	    #include <windows.h>
	    #undef WIN32_LEAN_AND_MEAN

	    int main(int argc, char** argv) {
		int a, b = 0;
		__try {
		    a = 666 / b;
		}
		__except (EXCEPTION_EXECUTE_HANDLER) {
		    return 0;
		}
		return 1;
	    }
	],
	    tcl_cv_seh=yes,
	    tcl_cv_seh=no,
	    tcl_cv_seh=no)
	)
	if test "$tcl_cv_seh" = "no" ; then
	    AC_DEFINE(HAVE_NO_SEH, 1,
		    [Defined when mingw does not support SEH])
	fi

	#
	# Check to see if the excpt.h include file provided contains the
	# definition for EXCEPTION_DISPOSITION; if not, which is the case
	# with Cygwin's version as of 2002-04-10, define it to be int,
	# sufficient for getting the current code to work.
	#
	AC_CACHE_CHECK(for EXCEPTION_DISPOSITION support in include files,
	    tcl_cv_eh_disposition,
	    AC_TRY_COMPILE([
#	    define WIN32_LEAN_AND_MEAN
#	    include <windows.h>
#	    undef WIN32_LEAN_AND_MEAN
	    ],[
		EXCEPTION_DISPOSITION x;
	    ],
		tcl_cv_eh_disposition=yes,
		tcl_cv_eh_disposition=no)
	)
	if test "$tcl_cv_eh_disposition" = "no" ; then
	AC_DEFINE(EXCEPTION_DISPOSITION, int,
		[Defined when cygwin/mingw does not support EXCEPTION DISPOSITION])
	fi

	# Check to see if winnt.h defines CHAR, SHORT, and LONG
	# even if VOID has already been #defined. The win32api
	# used by mingw and cygwin is known to do this.

	AC_CACHE_CHECK(for winnt.h that ignores VOID define,
	    tcl_cv_winnt_ignore_void,
	    AC_TRY_COMPILE([
		#define VOID void
		#define WIN32_LEAN_AND_MEAN
		#include <windows.h>
		#undef WIN32_LEAN_AND_MEAN
	    ], [
		CHAR c;
		SHORT s;
		LONG l;
	    ],
        tcl_cv_winnt_ignore_void=yes,
        tcl_cv_winnt_ignore_void=no)
	)
	if test "$tcl_cv_winnt_ignore_void" = "yes" ; then
	    AC_DEFINE(HAVE_WINNT_IGNORE_VOID, 1,
		    [Defined when cygwin/mingw ignores VOID define in winnt.h])
	fi

	# See if the compiler supports casting to a union type.
	# This is used to stop gcc from printing a compiler
	# warning when initializing a union member.

	AC_CACHE_CHECK(for cast to union support,
	    tcl_cv_cast_to_union,
	    AC_TRY_COMPILE([],
	    [
		  union foo { int i; double d; };
		  union foo f = (union foo) (int) 0;
	    ],
	    tcl_cv_cast_to_union=yes,
	    tcl_cv_cast_to_union=no)
	)
	if test "$tcl_cv_cast_to_union" = "yes"; then
	    AC_DEFINE(HAVE_CAST_TO_UNION, 1,
		    [Defined when compiler supports casting to union type.])
	fi
    fi

    # DL_LIBS is empty, but then we match the Unix version
    AC_SUBST(DL_LIBS)
    AC_SUBST(CFLAGS_DEBUG)
    AC_SUBST(CFLAGS_OPTIMIZE)
    AC_SUBST(CFLAGS_WARNING)
])

Changes to win/tclWinError.c.

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
/*
 * tclWinError.c --
 *
 *	This file contains code for converting from Win32 errors to errno
 *	errors.
 *
 * Copyright (c) 1995-1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The following table contains the mapping from Win32 errors to errno errors.
 */

static char errorTable[] = {
    0,
    EINVAL,	/* ERROR_INVALID_FUNCTION	1 */
    ENOENT,	/* ERROR_FILE_NOT_FOUND		2 */
    ENOENT,	/* ERROR_PATH_NOT_FOUND		3 */
    EMFILE,	/* ERROR_TOO_MANY_OPEN_FILES	4 */
    EACCES,	/* ERROR_ACCESS_DENIED		5 */
    EBADF,	/* ERROR_INVALID_HANDLE		6 */













<




|







1
2
3
4
5
6
7
8
9
10
11
12
13

14
15
16
17
18
19
20
21
22
23
24
25
/*
 * tclWinError.c --
 *
 *	This file contains code for converting from Win32 errors to errno
 *	errors.
 *
 * Copyright (c) 1995-1996 by Sun Microsystems, Inc.
 *
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclInt.h"

/*
 * The following table contains the mapping from Win32 errors to errno errors.
 */

static const unsigned char errorTable[] = {
    0,
    EINVAL,	/* ERROR_INVALID_FUNCTION	1 */
    ENOENT,	/* ERROR_FILE_NOT_FOUND		2 */
    ENOENT,	/* ERROR_PATH_NOT_FOUND		3 */
    EMFILE,	/* ERROR_TOO_MANY_OPEN_FILES	4 */
    EACCES,	/* ERROR_ACCESS_DENIED		5 */
    EBADF,	/* ERROR_INVALID_HANDLE		6 */
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
    EINVAL,	/* 260 */
    EINVAL,	/* 261 */
    EINVAL,	/* 262 */
    EINVAL,	/* 263 */
    EINVAL,	/* 264 */
    EINVAL,	/* 265 */
    EINVAL,	/* 266 */
    ENOTDIR,	/* ERROR_DIRECTORY		267 */
};

static const unsigned int tableLen = sizeof(errorTable);

/*
 * The following table contains the mapping from WinSock errors to
 * errno errors.
 */

static int wsaErrorTable[] = {
    EWOULDBLOCK,	/* WSAEWOULDBLOCK */
    EINPROGRESS,	/* WSAEINPROGRESS */
    EALREADY,		/* WSAEALREADY */
    ENOTSOCK,		/* WSAENOTSOCK */
    EDESTADDRREQ,	/* WSAEDESTADDRREQ */
    EMSGSIZE,		/* WSAEMSGSIZE */
    EPROTOTYPE,		/* WSAEPROTOTYPE */
    ENOPROTOOPT,	/* WSAENOPROTOOPT */







|


<
<





|
|







279
280
281
282
283
284
285
286
287
288


289
290
291
292
293
294
295
296
297
298
299
300
301
302
    EINVAL,	/* 260 */
    EINVAL,	/* 261 */
    EINVAL,	/* 262 */
    EINVAL,	/* 263 */
    EINVAL,	/* 264 */
    EINVAL,	/* 265 */
    EINVAL,	/* 266 */
    ENOTDIR	/* ERROR_DIRECTORY		267 */
};



/*
 * The following table contains the mapping from WinSock errors to
 * errno errors.
 */

static const unsigned char wsaErrorTable[] = {
    EAGAIN,		/* WSAEWOULDBLOCK */
    EINPROGRESS,	/* WSAEINPROGRESS */
    EALREADY,		/* WSAEALREADY */
    ENOTSOCK,		/* WSAENOTSOCK */
    EDESTADDRREQ,	/* WSAEDESTADDRREQ */
    EMSGSIZE,		/* WSAEMSGSIZE */
    EPROTOTYPE,		/* WSAEPROTOTYPE */
    ENOPROTOOPT,	/* WSAENOPROTOOPT */
327
328
329
330
331
332
333
334
335
336





337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357


358



359
360
361
362
363

364
365
366
367
368
369

370
371
372
373
374
375
376
377
378
379
380
381





382



383



384



385




386


387
388
389
390
391
392
393
394
395
396
397
398
    EHOSTDOWN,		/* WSAEHOSTDOWN */
    EHOSTUNREACH,	/* WSAEHOSTUNREACH */
    ENOTEMPTY,		/* WSAENOTEMPTY */
    EAGAIN,		/* WSAEPROCLIM */
    EUSERS,		/* WSAEUSERS */
    EDQUOT,		/* WSAEDQUOT */
    ESTALE,		/* WSAESTALE */
    EREMOTE,		/* WSAEREMOTE */
};






/*
 *----------------------------------------------------------------------
 *
 * TclWinConvertError --
 *
 *	This routine converts a Win32 error into an errno value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertError(
    unsigned long errCode)		/* Win32 error code. */
{
    if (errCode >= tableLen) {


	Tcl_SetErrno(EINVAL);



    } else {
	Tcl_SetErrno(errorTable[errCode]);
    }
}


/*
 *----------------------------------------------------------------------
 *
 * TclWinConvertWSAError --
 *
 *	This routine converts a WinSock error into an errno value.

 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertWSAError(





    unsigned long errCode)		/* Win32 error code. */



{



    if ((errCode >= WSAEWOULDBLOCK) && (errCode <= WSAEREMOTE)) {



	Tcl_SetErrno(wsaErrorTable[errCode - WSAEWOULDBLOCK]);




    } else {


	Tcl_SetErrno(EINVAL);
    }
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */







|


>
>
>
>
>


















|

|
>
>
|
>
>
>




|
>



|

|
>





|





|
>
>
>
>
>
|
>
>
>
|
>
>
>
|
>
>
>
|
>
>
>
>

>
>
|


|








324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
    EHOSTDOWN,		/* WSAEHOSTDOWN */
    EHOSTUNREACH,	/* WSAEHOSTUNREACH */
    ENOTEMPTY,		/* WSAENOTEMPTY */
    EAGAIN,		/* WSAEPROCLIM */
    EUSERS,		/* WSAEUSERS */
    EDQUOT,		/* WSAEDQUOT */
    ESTALE,		/* WSAESTALE */
    EREMOTE		/* WSAEREMOTE */
};

#ifdef __CYGWIN__
#   include <windows.h>
#   define DWORD unsigned int
#endif

/*
 *----------------------------------------------------------------------
 *
 * TclWinConvertError --
 *
 *	This routine converts a Win32 error into an errno value.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	Sets the errno global variable.
 *
 *----------------------------------------------------------------------
 */

void
TclWinConvertError(
    DWORD errCode)		/* Win32 error code. */
{
    if (errCode >= sizeof(errorTable)/sizeof(errorTable[0])) {
	errCode -= WSAEWOULDBLOCK;
	if (errCode >= sizeof(wsaErrorTable)/sizeof(wsaErrorTable[0])) {
	    Tcl_SetErrno(errorTable[1]);
	} else {
	    Tcl_SetErrno(wsaErrorTable[errCode]);
	}
    } else {
	Tcl_SetErrno(errorTable[errCode]);
    }
}

#ifdef __CYGWIN__
/*
 *----------------------------------------------------------------------
 *
 * tclWinDebugPanic --
 *
 *	Display a message. If a debugger is present, present it directly to
 *	the debugger, otherwise send it to stderr.
 *
 * Results:
 *	None.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

void
tclWinDebugPanic(
    const char *format, ...)
{
#define TCL_MAX_WARN_LEN 1024
    va_list argList;
    va_start(argList, format);

    if (IsDebuggerPresent()) {
	WCHAR msgString[TCL_MAX_WARN_LEN];
	char buf[TCL_MAX_WARN_LEN * TCL_UTF_MAX];

	vsnprintf(buf, sizeof(buf), format, argList);
	msgString[TCL_MAX_WARN_LEN-1] = L'\0';
	MultiByteToWideChar(CP_UTF8, 0, buf, -1, msgString, TCL_MAX_WARN_LEN);

	/*
	 * Truncate MessageBox string if it is too long to not overflow the buffer.
	 */

	if (msgString[TCL_MAX_WARN_LEN-1] != L'\0') {
	    memcpy(msgString + (TCL_MAX_WARN_LEN - 5), L" ...", 5 * sizeof(WCHAR));
	}
	OutputDebugStringW(msgString);
    } else {
	vfprintf(stderr, format, argList);
	fprintf(stderr, "\n");
	fflush(stderr);
    }
}
#endif
/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * tab-width: 8
 * End:
 */

Changes to win/tclWinFile.c.

1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
     * what permissions the OS has set for a file.
     */

#ifdef UNICODE
    {
	SECURITY_DESCRIPTOR *sdPtr = NULL;
	unsigned long size;
	SID *pSid = 0;
	BOOL SidDefaulted;
	SID_IDENTIFIER_AUTHORITY samba_unmapped = { 0, 0, 0, 0, 0, 22 };
	GENERIC_MAPPING genMap;
	HANDLE hToken = NULL;
	DWORD desiredAccess = 0, grantedAccess = 0;
	BOOL accessYesNo = FALSE;
	PRIVILEGE_SET privSet;
	DWORD privSetSize = sizeof(PRIVILEGE_SET);
	int error;







|

|







1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
     * what permissions the OS has set for a file.
     */

#ifdef UNICODE
    {
	SECURITY_DESCRIPTOR *sdPtr = NULL;
	unsigned long size;
	PSID pSid = 0;
	BOOL SidDefaulted;
	SID_IDENTIFIER_AUTHORITY samba_unmapped = {{0, 0, 0, 0, 0, 22}};
	GENERIC_MAPPING genMap;
	HANDLE hToken = NULL;
	DWORD desiredAccess = 0, grantedAccess = 0;
	BOOL accessYesNo = FALSE;
	PRIVILEGE_SET privSet;
	DWORD privSetSize = sizeof(PRIVILEGE_SET);
	int error;
1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
1838
1839
1840
1841
1842
1843
1844
1845
1846
1847
1848
1849
1850
1851
1852
1853
1854
1855
1856
1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886
1887
1888
1889
1890
1891
1892

int
TclpObjChdir(
    Tcl_Obj *pathPtr)	/* Path to new working directory. */
{
    int result;
    const TCHAR *nativePath;
#ifdef __CYGWIN__
    extern int cygwin_conv_to_posix_path(const char *, char *);
    char posixPath[MAX_PATH+1];
    const char *path;
    Tcl_DString ds;
#endif /* __CYGWIN__ */

    nativePath = Tcl_FSGetNativePath(pathPtr);

#ifdef __CYGWIN__
    /*
     * Cygwin chdir only groks POSIX path.
     */

    path = Tcl_WinTCharToUtf(nativePath, -1, &ds);
    cygwin_conv_to_posix_path(path, posixPath);
    result = (chdir(posixPath) == 0 ? 1 : 0);
    Tcl_DStringFree(&ds);
#else /* __CYGWIN__ */
    result = SetCurrentDirectory(nativePath);
#endif /* __CYGWIN__ */

    if (result == 0) {
	TclWinConvertError(GetLastError());
	return -1;
    }
    return 0;
}

#ifdef __CYGWIN__
/*
 *---------------------------------------------------------------------------
 *
 * TclpReadlink --
 *
 *	This function replaces the library version of readlink().
 *
 * Results:
 *	The result is a pointer to a string specifying the contents of the
 *	symbolic link given by 'path', or NULL if the symbolic link could not
 *	be read. Storage for the result string is allocated in bufferPtr; the
 *	caller must call Tcl_DStringFree() when the result is no longer
 *	needed.
 *
 * Side effects:
 *	See readlink() documentation.
 *
 *---------------------------------------------------------------------------
 */

char *
TclpReadlink(
    const char *path,		/* Path of file to readlink (UTF-8). */
    Tcl_DString *linkPtr)	/* Uninitialized or free DString filled with
				 * contents of link (UTF-8). */
{
    char link[MAXPATHLEN];
    int length;
    char *native;
    Tcl_DString ds;

    native = Tcl_UtfToExternalDString(NULL, path, -1, &ds);
    length = readlink(native, link, sizeof(link));	/* INTL: Native. */
    Tcl_DStringFree(&ds);

    if (length < 0) {
	return NULL;
    }

    Tcl_ExternalToUtfDString(NULL, link, length, linkPtr);
    return Tcl_DStringValue(linkPtr);
}
#endif /* __CYGWIN__ */

/*
 *----------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
 *	This function replaces the library version of getcwd(). (Obsolete
 *	function, only retained for old extensions which may call it







<
<
<
<
<
<



<
<
<
<
<
<
<
<
<
<

<








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







1805
1806
1807
1808
1809
1810
1811






1812
1813
1814










1815

1816
1817
1818
1819
1820
1821
1822
1823













































1824
1825
1826
1827
1828
1829
1830

int
TclpObjChdir(
    Tcl_Obj *pathPtr)	/* Path to new working directory. */
{
    int result;
    const TCHAR *nativePath;







    nativePath = Tcl_FSGetNativePath(pathPtr);











    result = SetCurrentDirectory(nativePath);


    if (result == 0) {
	TclWinConvertError(GetLastError());
	return -1;
    }
    return 0;
}














































/*
 *----------------------------------------------------------------------
 *
 * TclpGetCwd --
 *
 *	This function replaces the library version of getcwd(). (Obsolete
 *	function, only retained for old extensions which may call it

Changes to win/tclWinLoad.c.

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
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

/*

 * Mutex protecting static data in this file;

 */


static Tcl_Mutex loadMutex;

/*
 * Name of the directory in the native filesystem where DLLs used in this
 * process are copied prior to loading.

 */

static WCHAR* dllDirectoryName = NULL;

/* Static functions defined within this file */

void* FindSymbol(Tcl_Interp* interp, Tcl_LoadHandle loadHandle,
		 const char* symbol);
void UnloadFile(Tcl_LoadHandle loadHandle);


/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle







>
|
>


>
|


<
<
>


|
|
<
|
<
<
|
<







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
 * See the file "license.terms" for information on usage and redistribution of
 * this file, and for a DISCLAIMER OF ALL WARRANTIES.
 */

#include "tclWinInt.h"

/*
 * Native name of the directory in the native filesystem where DLLs used in
 * this process are copied prior to loading, and mutex used to protect its
 * allocation.
 */

static WCHAR *dllDirectoryName = NULL;
static Tcl_Mutex dllDirectoryNameMutex;

/*


 * Static functions defined within this file.
 */

static void *		FindSymbol(Tcl_Interp *interp,
			    Tcl_LoadHandle loadHandle, const char *symbol);

static int		InitDLLDirectoryName(void);


static void		UnloadFile(Tcl_LoadHandle loadHandle);


/*
 *----------------------------------------------------------------------
 *
 * TclpDlopen --
 *
 *	Dynamically loads a binary code file into memory and returns a handle
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativeName = Tcl_FSGetNativePath(pathPtr);
    hInstance = LoadLibraryEx(nativeName, NULL,
	    LOAD_WITH_ALTERED_SEARCH_PATH);
    if (hInstance == NULL) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;
	const char *fileName = Tcl_GetString(pathPtr);

	nativeName = Tcl_WinUtfToTChar(fileName, -1, &ds);
	hInstance = LoadLibraryEx(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError = GetLastError();

#if 0
	/*
	 * It would be ideal if the FormatMessage stuff worked better, but
	 * unfortunately it doesn't seem to want to...
	 */

	LPTSTR lpMsgBuf;
	char *buf;
	int size;

	size = FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM |
		FORMAT_MESSAGE_ALLOCATE_BUFFER, NULL, lastError, 0,
		(LPTSTR) &lpMsgBuf, 0, NULL);
	buf = ckalloc(TCL_INTEGER_SPACE + size + 1);
	sprintf(buf, "%d %s", lastError, (char *)lpMsgBuf);
#endif

	Tcl_AppendResult(interp, "couldn't load library \"",
		Tcl_GetString(pathPtr), "\": ", NULL);

	/*
	 * Check for possible DLL errors. This doesn't work quite right,
	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
	 * about any problem, but it's better than nothing. It'd be even







|
<








<

|








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







69
70
71
72
73
74
75
76

77
78
79
80
81
82
83
84

85
86
87
88
89
90
91
92
93
94

















95
96
97
98
99
100
101
    /*
     * First try the full path the user gave us. This is particularly
     * important if the cwd is inside a vfs, and we are trying to load using a
     * relative path.
     */

    nativeName = Tcl_FSGetNativePath(pathPtr);
    hInstance = LoadLibraryEx(nativeName,NULL,LOAD_WITH_ALTERED_SEARCH_PATH);

    if (hInstance == NULL) {
	/*
	 * Let the OS loader examine the binary search path for whatever
	 * string the user gave us which hopefully refers to a file on the
	 * binary path.
	 */

	Tcl_DString ds;


	nativeName = Tcl_WinUtfToTChar(Tcl_GetString(pathPtr), -1, &ds);
	hInstance = LoadLibraryEx(nativeName, NULL,
		LOAD_WITH_ALTERED_SEARCH_PATH);
	Tcl_DStringFree(&ds);
    }

    if (hInstance == NULL) {
	DWORD lastError = GetLastError();


















	Tcl_AppendResult(interp, "couldn't load library \"",
		Tcl_GetString(pathPtr), "\": ", NULL);

	/*
	 * Check for possible DLL errors. This doesn't work quite right,
	 * because Windows seems to only return ERROR_MOD_NOT_FOUND for just
	 * about any problem, but it's better than nothing. It'd be even
181
182
183
184
185
186
187
188
189
190
191
192
193

194
195
196
197
198
199
200
201
202
203
204
205

206
207
208
209
210
211
212
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{

    Tcl_PackageInitProc *proc = NULL;
    HINSTANCE hInstance = (HINSTANCE)(loadHandle->clientData);

    /*
     * For each symbol, check for both Symbol and _Symbol, since Borland
     * generates C symbols with a leading '_' by default.
     */

    proc = (void*) GetProcAddress(hInstance, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char* sym2;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "_", 1);
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {







|





>

<






|


|
>







160
161
162
163
164
165
166
167
168
169
170
171
172
173
174

175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
 *	Returns a pointer to the function associated with 'symbol' if it is
 *	found. Otherwise returns NULL and may leave an error message in the
 *	interp's result.
 *
 *----------------------------------------------------------------------
 */

static void *
FindSymbol(
    Tcl_Interp *interp,
    Tcl_LoadHandle loadHandle,
    const char *symbol)
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;
    Tcl_PackageInitProc *proc = NULL;


    /*
     * For each symbol, check for both Symbol and _Symbol, since Borland
     * generates C symbols with a leading '_' by default.
     */

    proc = (void *) GetProcAddress(hInstance, symbol);
    if (proc == NULL) {
	Tcl_DString ds;
	const char *sym2;

	Tcl_DStringInit(&ds);
	Tcl_DStringAppend(&ds, "_", 1);
	sym2 = Tcl_DStringAppend(&ds, symbol, -1);
	proc = (Tcl_PackageInitProc *) GetProcAddress(hInstance, sym2);
	Tcl_DStringFree(&ds);
    }
    if (proc == NULL && interp != NULL) {
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;








|







210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
 *
 * Side effects:
 *	Code removed from memory.
 *
 *----------------------------------------------------------------------
 */

static void
UnloadFile(
    Tcl_LoadHandle loadHandle)	/* loadHandle returned by a previous call to
				 * TclpDlopen(). The loadHandle is a token
				 * that represents the loaded file. */
{
    HINSTANCE hInstance = (HINSTANCE) loadHandle->clientData;

273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342

343
344
345
346
347
348
349
350
351

352
353
354
355
356

357
358

359
360
361
362
363
364
365

366
367
368
369














































































370
371
372
373
374
375
376
377
378
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 *-----------------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *
 *	Constructs a temporary file name for loading a shared object (DLL).
 *
 * Results:
 *	Returns the constructed file name.
 *
 * On Windows, a DLL is identified by the final component of its path name.
 * Cross linking among DLL's (and hence, preloading) will not work unless
 * this name is preserved when copying a DLL from a VFS to a temp file for
 * preloading. For this reason, all DLLs in a given process are copied
 * to a temp directory, and their names are preserved.
 *
 *-----------------------------------------------------------------------------
 */

Tcl_Obj*
TclpTempFileNameForLibrary(Tcl_Interp* interp, /* Tcl interpreter */

			   Tcl_Obj* path)      /* Path name of the DLL in
						* the VFS */
{
    size_t nameLen;		/* Length of the temp folder name */
    WCHAR name[MAX_PATH];	/* Path name of the temp folder */
    BOOL status;		/* Status from Win32 API calls */
    Tcl_Obj* fileName;		/* Name of the temp file */
    Tcl_Obj* tail;		/* Tail of the source path */

    /*
     * Determine the name of the directory to use, and create it.
     * (Keep trying with new names until an attempt to create the directory
     * succeeds)
     */

    nameLen = 0;
    if (dllDirectoryName == NULL) {
	Tcl_MutexLock(&loadMutex);
	if (dllDirectoryName == NULL) {
	    nameLen = GetTempPathW(MAX_PATH, name);
	    if (nameLen >= MAX_PATH-12) {
		Tcl_SetErrno(ENAMETOOLONG);
		nameLen = 0;
	    } else {
		wcscpy(name+nameLen, L"TCLXXXXXXXX");
		nameLen += 11;
	    }
	    status = 1;
	    if (nameLen != 0) {
		DWORD id;
		int i = 0;
		id = GetCurrentProcessId();
		for (;;) {
		    DWORD lastError;
		    wsprintfW(name+nameLen-8, L"%08x", id);
		    status = CreateDirectoryW(name, NULL);
		    if (status) {
			break;
		    }
		    if ((lastError = GetLastError()) != ERROR_ALREADY_EXISTS) {
			TclWinConvertError(lastError);
			break;
		    } else if (++i > 256) {

			TclWinConvertError(lastError);
			break;
		    }
		    id *= 16777619;
		}
	    }
	    if (status != 0) {
		dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
		wcscpy(dllDirectoryName, name);

	    }
	}
	Tcl_MutexUnlock(&loadMutex);
    }
    if (dllDirectoryName == NULL) {

	Tcl_AppendResult(interp, "couldn't create temporary directory: ",
		Tcl_PosixError(interp), NULL);

    }
    fileName = TclpNativeToNormalized(dllDirectoryName);
    tail = TclPathPart(interp, path, TCL_PATH_TAIL);
    if (tail == NULL) {
	Tcl_DecrRefCount(fileName);
	return NULL;
    } else {

	Tcl_AppendToObj(fileName, "/", 1);
	Tcl_AppendObjToObj(fileName, tail);
	return fileName;
    }














































































}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */







|









|
|
|
|

|


|
|
>
|
<

<
<
<
|
|
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
<
|
<
<
<
<
<
<
<
<
|
|
<
<
<
<
<
|
>
|
<
<
<
<
<
<
<
|
>
|
|
|
|
<
>
|
<
>
|





<
>
|
|
|
|
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>









253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281

282



283
284


















285








286
287





288
289
290







291
292
293
294
295
296

297
298

299
300
301
302
303
304
305

306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
    Tcl_DString *bufPtr)	/* Initialized empty dstring. Append package
				 * name to this if possible. */
{
    return 0;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpTempFileNameForLibrary --
 *
 *	Constructs a temporary file name for loading a shared object (DLL).
 *
 * Results:
 *	Returns the constructed file name.
 *
 * On Windows, a DLL is identified by the final component of its path name.
 * Cross linking among DLL's (and hence, preloading) will not work unless this
 * name is preserved when copying a DLL from a VFS to a temp file for
 * preloading. For this reason, all DLLs in a given process are copied to a
 * temp directory, and their names are preserved.
 *
 *----------------------------------------------------------------------
 */

Tcl_Obj *
TclpTempFileNameForLibrary(
    Tcl_Interp *interp,		/* Tcl interpreter. */
    Tcl_Obj *path)		/* Path name of the DLL in the VFS. */

{



    Tcl_Obj *fileName;		/* Name of the temp file. */
    Tcl_Obj *tail;		/* Tail of the source path. */



























    Tcl_MutexLock(&dllDirectoryNameMutex);
    if (dllDirectoryName == NULL) {





	if (InitDLLDirectoryName() == TCL_ERROR) {
	    Tcl_AppendResult(interp, "couldn't create temporary directory: ",
		    Tcl_PosixError(interp), NULL);







	    Tcl_MutexUnlock(&dllDirectoryNameMutex);
	    return NULL;
	}
    }
    Tcl_MutexUnlock(&dllDirectoryNameMutex);


    /*
     * Now we know where to put temporary DLLs, construct the name.

     */

    fileName = TclpNativeToNormalized(dllDirectoryName);
    tail = TclPathPart(interp, path, TCL_PATH_TAIL);
    if (tail == NULL) {
	Tcl_DecrRefCount(fileName);
	return NULL;

    }
    Tcl_AppendToObj(fileName, "/", 1);
    Tcl_AppendObjToObj(fileName, tail);
    return fileName;
}

/*
 *----------------------------------------------------------------------
 *
 * InitDLLDirectoryName --
 *
 *	Helper for TclpTempFileNameForLibrary; builds a temporary directory
 *	that is specific to the current process. Should only be called once
 *	per process start. Caller must hold dllDirectoryNameMutex.
 *
 * Results:
 *	Tcl result code.
 *
 * Side-effects:
 *	Creates temp directory.
 *	Allocates memory pointed to by dllDirectoryName.
 *
 *----------------------------------------------------------------------
 * [Candidate for process global?]
 */

static int
InitDLLDirectoryName(void)
{
    size_t nameLen;		/* Length of the temp folder name. */
    WCHAR name[MAX_PATH];	/* Path name of the temp folder. */
    DWORD id;			/* The process id. */
    DWORD lastError;		/* Last error to happen in Win API. */
    int i;

    /*
     * Determine the name of the directory to use, and create it.  (Keep
     * trying with new names until an attempt to create the directory
     * succeeds)
     */

    nameLen = GetTempPathW(MAX_PATH, name);
    if (nameLen >= MAX_PATH-12) {
	Tcl_SetErrno(ENAMETOOLONG);
	return TCL_ERROR;
    }

    wcscpy(name+nameLen, L"TCLXXXXXXXX");
    nameLen += 11;

    id = GetCurrentProcessId();
    lastError = ERROR_ALREADY_EXISTS;

    for (i=0 ; i<256 ; i++) {
	wsprintfW(name+nameLen-8, L"%08x", id);
	if (CreateDirectoryW(name, NULL)) {
	    /*
	     * Issue: we don't schedule this directory for deletion by anyone.
	     * Can we ask the OS to do this for us?  There appears to be
	     * potential for using CreateFile (with the flag
	     * FILE_FLAG_BACKUP_SEMANTICS) and RemoveDirectory to do this...
	     */

	    goto copyToGlobalBuffer;
	}
	lastError = GetLastError();
	if (lastError != ERROR_ALREADY_EXISTS) {
	    break;
	}
	id *= 16777619;
    }

    TclWinConvertError(lastError);
    return TCL_ERROR;

    /*
     * Store our computed value in the global.
     */

  copyToGlobalBuffer:
    dllDirectoryName = ckalloc((nameLen+1) * sizeof(WCHAR));
    wcscpy(dllDirectoryName, name);
    return TCL_OK;
}

/*
 * Local Variables:
 * mode: c
 * c-basic-offset: 4
 * fill-column: 78
 * End:
 */

Changes to win/tclWinPort.h.

32
33
34
35
36
37
38






39
40
41
42
43
44
45
#   define _WIN32_WINNT 0x0501
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN







/*
 * Ask for the winsock function typedefs, also.
 */
#define INCL_WINSOCK_API_TYPEDEFS   1
#include <winsock2.h>
#include <ws2tcpip.h>
#ifdef HAVE_WSPIAPI_H







>
>
>
>
>
>







32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
#   define _WIN32_WINNT 0x0501
#endif

#define WIN32_LEAN_AND_MEAN
#include <windows.h>
#undef WIN32_LEAN_AND_MEAN

/* Compatibility to older visual studio / windows platform SDK */
#if !defined(MAXULONG_PTR)
typedef DWORD DWORD_PTR;
typedef DWORD_PTR * PDWORD_PTR;
#endif

/*
 * Ask for the winsock function typedefs, also.
 */
#define INCL_WINSOCK_API_TYPEDEFS   1
#include <winsock2.h>
#include <ws2tcpip.h>
#ifdef HAVE_WSPIAPI_H
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
#include <fcntl.h>
#include <float.h>
#include <malloc.h>
#include <process.h>
#include <signal.h>
#include <limits.h>

#ifdef __CYGWIN__
#   include <unistd.h>
#   ifndef _vsnprintf
#	define _vsnprintf vsnprintf
#   endif
#   ifndef _wcsicmp
#	define _wcsicmp wcscasecmp
#   endif
#else
#   ifndef strncasecmp
#	define strncasecmp strnicmp
#   endif
#   ifndef strcasecmp
#	define strcasecmp stricmp
#   endif
#endif

/*
 * Need to block out these includes for building extensions with MetroWerks
 * compiler for Win32.
 */

#ifndef __MWERKS__
#include <sys/stat.h>
#include <sys/timeb.h>
#   ifdef __BORLANDC__
#	include <utime.h>
#   else
#	include <sys/utime.h>
#   endif /* __BORLANDC__ */
#endif /* __MWERKS__ */

#include <time.h>

/*
 * cygwin does not have this struct.
 */
#ifdef __CYGWIN__
  struct _stat32i64 {
    dev_t st_dev;
    ino_t st_ino;
    unsigned short st_mode;
    short st_nlink;
    short st_uid;
    short st_gid;
    dev_t st_rdev;
    __int64 st_size;
    struct {long tv_sec;} st_atim;
    struct {long tv_sec;} st_mtim;
    struct {long tv_sec;} st_ctim;
  };
#endif

/*
 * The following defines redefine the Windows Socket errors as
 * BSD errors so Tcl_PosixError can do the right thing.
 */

#ifndef ENOTEMPTY
#   define ENOTEMPTY 	41	/* Directory not empty */







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



















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







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
#include <fcntl.h>
#include <float.h>
#include <malloc.h>
#include <process.h>
#include <signal.h>
#include <limits.h>










#ifndef strncasecmp
#   define strncasecmp strnicmp
#endif
#ifndef strcasecmp
#   define strcasecmp stricmp

#endif

/*
 * Need to block out these includes for building extensions with MetroWerks
 * compiler for Win32.
 */

#ifndef __MWERKS__
#include <sys/stat.h>
#include <sys/timeb.h>
#   ifdef __BORLANDC__
#	include <utime.h>
#   else
#	include <sys/utime.h>
#   endif /* __BORLANDC__ */
#endif /* __MWERKS__ */

#include <time.h>




















/*
 * The following defines redefine the Windows Socket errors as
 * BSD errors so Tcl_PosixError can do the right thing.
 */

#ifndef ENOTEMPTY
#   define ENOTEMPTY 	41	/* Directory not empty */
245
246
247
248
249
250
251
252
253
254

255
256
257
258
259
260
261
#endif
#ifndef EOPNOTSUPP
#   define EOPNOTSUPP	130	/* Operation not supported on socket */
#endif
#ifndef EOTHER
#   define EOTHER	131	/* Other error */
#endif
/* workaround for mingw-w64 bug 3407992 */
#undef EOVERFLOW
#define EOVERFLOW	132	/* File too big */

#ifndef EOWNERDEAD
#   define EOWNERDEAD	133	/* Owner dead */
#endif
#ifndef EPROTO
#   define EPROTO	134	/* Protocol error */
#endif
#ifndef EPROTONOSUPPORT







<
|
|
>







222
223
224
225
226
227
228

229
230
231
232
233
234
235
236
237
238
#endif
#ifndef EOPNOTSUPP
#   define EOPNOTSUPP	130	/* Operation not supported on socket */
#endif
#ifndef EOTHER
#   define EOTHER	131	/* Other error */
#endif

#ifndef EOVERFLOW
#   define EOVERFLOW	132	/* File too big */
#endif
#ifndef EOWNERDEAD
#   define EOWNERDEAD	133	/* Owner dead */
#endif
#ifndef EPROTO
#   define EPROTO	134	/* Protocol error */
#endif
#ifndef EPROTONOSUPPORT
274
275
276
277
278
279
280

281
282

283
284

285
286

287
288

289
290

291
292

293
294

295
296
297
298
299
300
301
#   define ETXTBSY	139	/* Text file or pseudo-device busy */
#endif
#ifndef EWOULDBLOCK
#   define EWOULDBLOCK	140	/* Operation would block */
#endif



#undef ESOCKTNOSUPPORT
#define ESOCKTNOSUPPORT WSAESOCKTNOSUPPORT	/* Socket type not supported */

#undef ESHUTDOWN
#define ESHUTDOWN	WSAESHUTDOWN	/* Can't send after socket shutdown */

#undef ETOOMANYREFS
#define ETOOMANYREFS	WSAETOOMANYREFS	/* Too many references: can't splice */

#undef EHOSTDOWN
#define EHOSTDOWN	WSAEHOSTDOWN	/* Host is down */

#undef EUSERS
#define EUSERS	WSAEUSERS	/* Too many users (for UFS) */

#undef EDQUOT
#define EDQUOT	WSAEDQUOT	/* Disc quota exceeded */

#undef ESTALE
#define ESTALE	WSAESTALE	/* Stale NFS file handle */


/*
 * Signals not known to the standard ANSI signal.h.  These are used
 * by Tcl_WaitPid() and generic/tclPosixStr.c
 */

#ifndef SIGTRAP







>
|
|
>
|
|
>
|
|
>
|
|
>
|
|
>
|
|
>
|
|
>







251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
#   define ETXTBSY	139	/* Text file or pseudo-device busy */
#endif
#ifndef EWOULDBLOCK
#   define EWOULDBLOCK	140	/* Operation would block */
#endif


/* Visual Studio doesn't have these, so just choose some high numbers */
#ifndef ESOCKTNOSUPPORT
#   define ESOCKTNOSUPPORT 240	/* Socket type not supported */
#endif
#ifndef ESHUTDOWN
#   define ESHUTDOWN	241	/* Can't send after socket shutdown */
#endif
#ifndef ETOOMANYREFS
#   define ETOOMANYREFS	242	/* Too many references: can't splice */
#endif
#ifndef EHOSTDOWN
#   define EHOSTDOWN	243	/* Host is down */
#endif
#ifndef EUSERS
#   define EUSERS	244	/* Too many users (for UFS) */
#endif
#ifndef EDQUOT
#   define EDQUOT	245	/* Disc quota exceeded */
#endif
#ifndef ESTALE
#   define ESTALE	246	/* Stale NFS file handle */
#endif

/*
 * Signals not known to the standard ANSI signal.h.  These are used
 * by Tcl_WaitPid() and generic/tclPosixStr.c
 */

#ifndef SIGTRAP
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487

#ifdef  __BORLANDC__
#   define timezone _timezone
#   define environ  _environ
#endif /* __BORLANDC__ */

#ifdef __WATCOMC__
    /*
     * OpenWatcom uses a wine derived winsock2.h that is missing the
     * LPFN_* typedefs.
     */
#   define HAVE_NO_LPFN_DECLS
#   if !defined(__CHAR_SIGNED__)
#	error "You must use the -j switch to ensure char is signed."
#   endif
#endif


/*







<
<
<
<
<







454
455
456
457
458
459
460





461
462
463
464
465
466
467

#ifdef  __BORLANDC__
#   define timezone _timezone
#   define environ  _environ
#endif /* __BORLANDC__ */

#ifdef __WATCOMC__





#   if !defined(__CHAR_SIGNED__)
#	error "You must use the -j switch to ensure char is signed."
#   endif
#endif


/*
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
#if defined(_MSC_VER) || defined(__MINGW32__)
#   define HAVE_PUTENV_THAT_COPIES 1
#endif

/*
 * Older version of Mingw are known to lack a MWMO_ALERTABLE define.
 */
#if defined(HAVE_NO_MWMO_ALERTABLE)
#   define MWMO_ALERTABLE 2
#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */

#ifdef __CYGWIN__
#   define TclpSysAlloc(size, isBin)	malloc((size))
#   define TclpSysFree(ptr)		free((ptr))
#   define TclpSysRealloc(ptr, size)	realloc((ptr), (size))
#else
#   define TclpSysAlloc(size, isBin)	((void*)HeapAlloc(GetProcessHeap(), \
					    (DWORD)0, (DWORD)size))
#   define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    (DWORD)0, (HGLOBAL)ptr))
#   define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    (DWORD)0, (LPVOID)ptr, (DWORD)size))
#endif

/*
 * The following defines map from standard socket names to our internal
 * wrappers that redirect through the winSock function table (see the
 * file tclWinSock.c).
 */








|








<
<
<
<
<
|

|

|

<







510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525





526
527
528
529
530
531

532
533
534
535
536
537
538
#if defined(_MSC_VER) || defined(__MINGW32__)
#   define HAVE_PUTENV_THAT_COPIES 1
#endif

/*
 * Older version of Mingw are known to lack a MWMO_ALERTABLE define.
 */
#if !defined(MWMO_ALERTABLE)
#   define MWMO_ALERTABLE 2
#endif

/*
 * The following defines wrap the system memory allocation routines for
 * use by tclAlloc.c.
 */






#define TclpSysAlloc(size, isBin)	((void*)HeapAlloc(GetProcessHeap(), \
					    (DWORD)0, (DWORD)size))
#define TclpSysFree(ptr)		(HeapFree(GetProcessHeap(), \
					    (DWORD)0, (HGLOBAL)ptr))
#define TclpSysRealloc(ptr, size)	((void*)HeapReAlloc(GetProcessHeap(), \
					    (DWORD)0, (LPVOID)ptr, (DWORD)size))


/*
 * The following defines map from standard socket names to our internal
 * wrappers that redirect through the winSock function table (see the
 * file tclWinSock.c).
 */

583
584
585
586
587
588
589
590




591
 */

#define TclpExit		exit

#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
#endif /* INVALID_SET_FILE_POINTER */





#endif /* _TCLWINPORT */








>
>
>
>

557
558
559
560
561
562
563
564
565
566
567
568
569
 */

#define TclpExit		exit

#ifndef INVALID_SET_FILE_POINTER
#define INVALID_SET_FILE_POINTER 0xFFFFFFFF
#endif /* INVALID_SET_FILE_POINTER */

#ifndef LABEL_SECURITY_INFORMATION
#   define LABEL_SECURITY_INFORMATION (0x00000010L)
#endif

#endif /* _TCLWINPORT */

Changes to win/tclWinSerial.c.

1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
    timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
    if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
	/*
	 * The writer thread is blocked waiting for a write to complete and
	 * the channel is in non-blocking mode.
	 */

	errno = EWOULDBLOCK;
	goto error1;
    }

    /*
     * Check for a background error on the last write.
     */








|







1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
    timeout = (infoPtr->flags & SERIAL_ASYNC) ? 0 : INFINITE;
    if (WaitForSingleObject(infoPtr->evWritable, timeout) == WAIT_TIMEOUT) {
	/*
	 * The writer thread is blocked waiting for a write to complete and
	 * the channel is in non-blocking mode.
	 */

	errno = EAGAIN;
	goto error1;
    }

    /*
     * Check for a background error on the last write.
     */

Changes to win/tclWinSock.c.

43
44
45
46
47
48
49







50
51
52
53
54
55
56
 *
 *   (Ad 2) The main functions for this are SocketSetupProc() and
 *          SocketCheckProc().
 */

#include "tclWinInt.h"








#ifdef _MSC_VER
#   pragma comment (lib, "ws2_32")
#endif

/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.







>
>
>
>
>
>
>







43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
 *
 *   (Ad 2) The main functions for this are SocketSetupProc() and
 *          SocketCheckProc().
 */

#include "tclWinInt.h"

/*
 * Which version of the winsock API do we want?
 */

#define WSA_VERSION_MAJOR	1
#define WSA_VERSION_MINOR	1

#ifdef _MSC_VER
#   pragma comment (lib, "ws2_32")
#endif

/*
 * Support for control over sockets' KEEPALIVE and NODELAY behavior is
 * currently disabled.
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103

104
105
106
107
108
109
110
    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
};

/*
 * The following defines declare the messages used on socket windows.
 */

#define SOCKET_MESSAGE	    WM_USER+1
#define SOCKET_SELECT	    WM_USER+2
#define SOCKET_TERMINATE    WM_USER+3
#define SELECT		    TRUE
#define UNSELECT	    FALSE

/*
 * This is needed to comply with the strict aliasing rules of GCC, but it also
 * simplifies casting between the different sockaddr types.
 */

typedef union {
    struct sockaddr sa;
    struct sockaddr_in sa4;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;








|
|
|
|
|





>







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
    0, 0, NULL, NULL, InitializeHostName, NULL, NULL
};

/*
 * The following defines declare the messages used on socket windows.
 */

#define SOCKET_MESSAGE		WM_USER+1
#define SOCKET_SELECT		WM_USER+2
#define SOCKET_TERMINATE	WM_USER+3
#define SELECT			TRUE
#define UNSELECT		FALSE

/*
 * This is needed to comply with the strict aliasing rules of GCC, but it also
 * simplifies casting between the different sockaddr types.
 */

typedef union {
    struct sockaddr sa;
    struct sockaddr_in sa4;
    struct sockaddr_in6 sa6;
    struct sockaddr_storage sas;
} address;

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
/*
 * Static functions defined in this file.
 */

static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
			    const char *host, int server, const char *myaddr,
			    int myport, int async);
#if 0
static int		CreateSocketAddress(LPSOCKADDR_IN sockaddrPtr,
			    const char *host, int port);
#endif
static void		InitSockets(void);
static SocketInfo *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds);







<
<
<
<







210
211
212
213
214
215
216




217
218
219
220
221
222
223
/*
 * Static functions defined in this file.
 */

static SocketInfo *	CreateSocket(Tcl_Interp *interp, int port,
			    const char *host, int server, const char *myaddr,
			    int myport, int async);




static void		InitSockets(void);
static SocketInfo *	NewSocketInfo(SOCKET socket);
static void		SocketExitHandler(ClientData clientData);
static LRESULT CALLBACK	SocketProc(HWND hwnd, UINT message, WPARAM wParam,
			    LPARAM lParam);
static int		SocketsEnabled(void);
static void		TcpAccept(TcpFdList *fds);
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
 *
 *----------------------------------------------------------------------
 */

static void
InitSockets(void)
{
    DWORD id;
    WSADATA wsaData;
    DWORD err;
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*







|

<







284
285
286
287
288
289
290
291
292

293
294
295
296
297
298
299
 *
 *----------------------------------------------------------------------
 */

static void
InitSockets(void)
{
    DWORD id, err;
    WSADATA wsaData;

    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    if (!initialized) {
	initialized = 1;
	TclCreateLateExitHandler(SocketExitHandler, NULL);

	/*
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357









358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397

	/*
	 * Initialize the winsock library and check the interface version
	 * actually loaded. We only ask for the 1.1 interface and do require
	 * that it not be less than 1.1.
	 */

#define WSA_VERSION_MAJOR 1
#define WSA_VERSION_MINOR 1
#define WSA_VERSION_REQD  MAKEWORD(WSA_VERSION_MAJOR, WSA_VERSION_MINOR)

	err = WSAStartup((WORD)WSA_VERSION_REQD, &wsaData);
	if (err != 0) {
	    TclWinConvertWSAError(err);
	    goto initFailure;
	}

	/*
	 * Note the byte positions are swapped for the comparison, so that
	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1).
	 * We want the comparison to be 0x0200 < 0x0101.
	 */

	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
	    TclWinConvertWSAError(WSAVERNOTSUPPORTED);
	    WSACleanup();
	    goto initFailure;
	}

#undef WSA_VERSION_REQD
#undef WSA_VERSION_MAJOR
#undef WSA_VERSION_MINOR
    }

    /*
     * Check for per-thread initialization.
     */

    if (tsdPtr == NULL) {









	tsdPtr = TCL_TSD_INIT(&dataKey);
	tsdPtr->socketList = NULL;
	tsdPtr->hwnd       = NULL;
	tsdPtr->threadId   = Tcl_GetCurrentThread();
	tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
	if (tsdPtr->readyEvent == NULL) {
	    goto initFailure;
	}
	tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
	if (tsdPtr->socketListLock == NULL) {
	    goto initFailure;
	}
	tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr,
		0, &id);
	if (tsdPtr->socketThread == NULL) {
	    goto initFailure;
	}

	SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);

	/*
	 * Wait for the thread to signal when the window has been created and
	 * if it is ready to go.
	 */

	WaitForSingleObject(tsdPtr->readyEvent, INFINITE);

	if (tsdPtr->hwnd == NULL) {
	    goto initFailure; /* Trouble creating the window */
	}

	Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);
    }
    return;

  initFailure:
    TclpFinalizeSockets();
    initialized = -1;
    return;
}







<
<
|
|
<

|




|
|
|




|



<
<
<
<






|
>
>
>
>
>
>
>
>
>
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|

|

|
|
|
|

|

|
|
|

|
<







321
322
323
324
325
326
327


328
329

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




347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394

395
396
397
398
399
400
401

	/*
	 * Initialize the winsock library and check the interface version
	 * actually loaded. We only ask for the 1.1 interface and do require
	 * that it not be less than 1.1.
	 */



	err = WSAStartup((WORD) MAKEWORD(WSA_VERSION_MAJOR,WSA_VERSION_MINOR),
		&wsaData);

	if (err != 0) {
	    TclWinConvertError(err);
	    goto initFailure;
	}

	/*
	 * Note the byte positions ae swapped for the comparison, so that
	 * 0x0002 (2.0, MAKEWORD(2,0)) doesn't look less than 0x0101 (1.1). We
	 * want the comparison to be 0x0200 < 0x0101.
	 */

	if (MAKEWORD(HIBYTE(wsaData.wVersion), LOBYTE(wsaData.wVersion))
		< MAKEWORD(WSA_VERSION_MINOR, WSA_VERSION_MAJOR)) {
	    TclWinConvertError(WSAVERNOTSUPPORTED);
	    WSACleanup();
	    goto initFailure;
	}




    }

    /*
     * Check for per-thread initialization.
     */

    if (tsdPtr != NULL) {
	return;
    }

    /*
     * OK, this thread has never done anything with sockets before.  Construct
     * a worker thread to handle asynchronous events related to sockets
     * assigned to _this_ thread.
     */

    tsdPtr = TCL_TSD_INIT(&dataKey);
    tsdPtr->socketList = NULL;
    tsdPtr->hwnd       = NULL;
    tsdPtr->threadId   = Tcl_GetCurrentThread();
    tsdPtr->readyEvent = CreateEvent(NULL, FALSE, FALSE, NULL);
    if (tsdPtr->readyEvent == NULL) {
	goto initFailure;
    }
    tsdPtr->socketListLock = CreateEvent(NULL, FALSE, TRUE, NULL);
    if (tsdPtr->socketListLock == NULL) {
	goto initFailure;
    }
    tsdPtr->socketThread = CreateThread(NULL, 256, SocketThread, tsdPtr, 0,
	    &id);
    if (tsdPtr->socketThread == NULL) {
	goto initFailure;
    }

    SetThreadPriority(tsdPtr->socketThread, THREAD_PRIORITY_HIGHEST);

    /*
     * Wait for the thread to signal when the window has been created and if
     * it is ready to go.
     */

    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);

    if (tsdPtr->hwnd == NULL) {
	goto initFailure;	/* Trouble creating the window. */
    }

    Tcl_CreateEventSource(SocketSetupProc, SocketCheckProc, NULL);

    return;

  initFailure:
    TclpFinalizeSockets();
    initialized = -1;
    return;
}
413
414
415
416
417
418
419

420
421
422
423
424
425
426
 */

    /* ARGSUSED */
static int
SocketsEnabled(void)
{
    int enabled;

    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}









>







417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
 */

    /* ARGSUSED */
static int
SocketsEnabled(void)
{
    int enabled;

    Tcl_MutexLock(&socketMutex);
    enabled = (initialized == 1);
    Tcl_MutexUnlock(&socketMutex);
    return enabled;
}


443
444
445
446
447
448
449

450
451
452
453
454
455
456

    /* ARGSUSED */
static void
SocketExitHandler(
    ClientData clientData)		/* Not used. */
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

    TclpFinalizeSockets();
    UnregisterClass(classname, TclWinGetTclInstance());







>







448
449
450
451
452
453
454
455
456
457
458
459
460
461
462

    /* ARGSUSED */
static void
SocketExitHandler(
    ClientData clientData)		/* Not used. */
{
    Tcl_MutexLock(&socketMutex);

    /*
     * Make sure the socket event handling window is cleaned-up for, at
     * most, this thread.
     */

    TclpFinalizeSockets();
    UnregisterClass(classname, TclWinGetTclInstance());
479
480
481
482
483
484
485




486



487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
 */

void
TclpFinalizeSockets(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);





    if (tsdPtr != NULL) {



	if (tsdPtr->socketThread != NULL) {
	    if (tsdPtr->hwnd != NULL) {
		PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);

		/*
		 * Wait for the thread to exit. This ensures that we are
		 * completely cleaned up before we leave this function.
		 */

		WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
		tsdPtr->hwnd = NULL;
	    }
	    CloseHandle(tsdPtr->socketThread);
	    tsdPtr->socketThread = NULL;
	}
	if (tsdPtr->readyEvent != NULL) {
	    CloseHandle(tsdPtr->readyEvent);
	    tsdPtr->readyEvent = NULL;
	}
	if (tsdPtr->socketListLock != NULL) {
	    CloseHandle(tsdPtr->socketListLock);
	    tsdPtr->socketListLock = NULL;
	}
	Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);
    }
}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *







>
>
>
>
|
>
>
>
|
|
|

|
|
|
|

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







485
486
487
488
489
490
491
492
493
494
495
496
497
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
 */

void
TclpFinalizeSockets(void)
{
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Careful! This is a finalizer!
     */

    if (tsdPtr == NULL) {
	return;
    }

    if (tsdPtr->socketThread != NULL) {
	if (tsdPtr->hwnd != NULL) {
	    PostMessage(tsdPtr->hwnd, SOCKET_TERMINATE, 0, 0);

	    /*
	     * Wait for the thread to exit. This ensures that we are
	     * completely cleaned up before we leave this function.
	     */

	    WaitForSingleObject(tsdPtr->readyEvent, INFINITE);
	    tsdPtr->hwnd = NULL;
	}
	CloseHandle(tsdPtr->socketThread);
	tsdPtr->socketThread = NULL;
    }
    if (tsdPtr->readyEvent != NULL) {
	CloseHandle(tsdPtr->readyEvent);
	tsdPtr->readyEvent = NULL;
    }
    if (tsdPtr->socketListLock != NULL) {
	CloseHandle(tsdPtr->socketListLock);
	tsdPtr->socketListLock = NULL;
    }
    Tcl_DeleteEventSource(SocketSetupProc, SocketCheckProc, NULL);

}

/*
 *----------------------------------------------------------------------
 *
 * TclpHasSockets --
 *
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
SocketEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    SocketInfo *infoPtr;
    SocketEvent *eventPtr = (SocketEvent *) evPtr;
    int mask = 0;
    int events;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TcpFdList *fds;

    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }








|
<







685
686
687
688
689
690
691
692

693
694
695
696
697
698
699
SocketEventProc(
    Tcl_Event *evPtr,		/* Event to service. */
    int flags)			/* Flags that indicate what events to handle,
				 * such as TCL_FILE_EVENTS. */
{
    SocketInfo *infoPtr;
    SocketEvent *eventPtr = (SocketEvent *) evPtr;
    int mask = 0, events;

    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    TcpFdList *fds;

    if (!(flags & TCL_FILE_EVENTS)) {
	return 0;
    }

735
736
737
738
739
740
741

742
743
744
745
746
747
748
	 * do this before calling Tcl_NotifyChannel so we don't have to watch
	 * out for the channel being deleted out from under us. This may cause
	 * a redundant trip through the event loop, but it's simpler than
	 * trying to do unwind protection.
	 */

	Tcl_Time blockTime = { 0, 0 };

	Tcl_SetMaxBlockTime(&blockTime);
	mask |= TCL_READABLE|TCL_WRITABLE;
    } else if (events & FD_READ) {
	fd_set readFds;
	struct timeval timeout;

	/*







>







746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
	 * do this before calling Tcl_NotifyChannel so we don't have to watch
	 * out for the channel being deleted out from under us. This may cause
	 * a redundant trip through the event loop, but it's simpler than
	 * trying to do unwind protection.
	 */

	Tcl_Time blockTime = { 0, 0 };

	Tcl_SetMaxBlockTime(&blockTime);
	mask |= TCL_READABLE|TCL_WRITABLE;
    } else if (events & FD_READ) {
	fd_set readFds;
	struct timeval timeout;

	/*
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
	/*
	 * Clean up the OS socket handle. The default Windows setting for a
	 * socket is SO_DONTLINGER, which does a graceful shutdown in the
	 * background.
	 */

	if (closesocket(infoPtr->sockets->fd) == SOCKET_ERROR) {
	    TclWinConvertWSAError((DWORD) WSAGetLastError());
	    errorCode = Tcl_GetErrno();
	}
    }

    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only







|







869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
	/*
	 * Clean up the OS socket handle. The default Windows setting for a
	 * socket is SO_DONTLINGER, which does a graceful shutdown in the
	 * background.
	 */

	if (closesocket(infoPtr->sockets->fd) == SOCKET_ERROR) {
	    TclWinConvertError((DWORD) WSAGetLastError());
	    errorCode = Tcl_GetErrno();
	}
    }

    /*
     * TIP #218. Removed the code removing the structure from the global
     * socket list. This is now done by the thread action callbacks, and only
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911

912
913
914
915
916
917
918
919
920
921
922
923
924

925
926
927
928
929
930
931
932
933
static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    SocketInfo *infoPtr = instanceData;
    int errorCode = 0;
    int sd;

    /*
     * Shutdown the OS socket handle.
     */
    switch(flags)
	{

	case TCL_CLOSE_READ:
	    sd=SD_RECEIVE;
	    break;
	case TCL_CLOSE_WRITE:
	    sd=SD_SEND;
	    break;
	default:
	    if (interp) {
		Tcl_AppendResult(interp,
			"Socket close2proc called bidirectionally", NULL);
	    }
	    return TCL_ERROR;
	}

    if (shutdown(infoPtr->sockets->fd,sd) == SOCKET_ERROR) {
	TclWinConvertWSAError((DWORD) WSAGetLastError());
	errorCode = Tcl_GetErrno();
    }

    return errorCode;
}

/*







|
<




<
|
>
|
|
|
|
|
|
|
|
|
|
|
|
|
>
|
|







909
910
911
912
913
914
915
916

917
918
919
920

921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
static int
TcpClose2Proc(
    ClientData instanceData,	/* The socket to close. */
    Tcl_Interp *interp,		/* For error reporting. */
    int flags)			/* Flags that indicate which side to close. */
{
    SocketInfo *infoPtr = instanceData;
    int errorCode = 0, sd;


    /*
     * Shutdown the OS socket handle.
     */


    switch (flags) {
    case TCL_CLOSE_READ:
	sd = SD_RECEIVE;
	break;
    case TCL_CLOSE_WRITE:
	sd = SD_SEND;
	break;
    default:
	if (interp) {
	    Tcl_AppendResult(interp,
		    "Socket close2proc called bidirectionally", NULL);
	}
	return TCL_ERROR;
    }

    if (shutdown(infoPtr->sockets->fd, sd) == SOCKET_ERROR) {
	TclWinConvertError((DWORD) WSAGetLastError());
	errorCode = Tcl_GetErrno();
    }

    return errorCode;
}

/*
1008
1009
1010
1011
1012
1013
1014
1015

1016

1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031




1032

1033
1034
1035

1036
1037
1038
1039
1040

1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
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
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
    int async)			/* If nonzero, connect client socket
				 * asynchronously. */
{
    u_long flag = 1;		/* Indicates nonblocking mode. */
    int asyncConnect = 0;	/* Will be 1 if async connect is in
				 * progress. */
    unsigned short chosenport = 0;
    struct addrinfo *addrlist = NULL, *addrPtr;	/* socket address */

    struct addrinfo *myaddrlist = NULL, *myaddrPtr; /* Socket address for client */

    const char *errorMsg = NULL;
    SOCKET sock = INVALID_SOCKET;
    SocketInfo *infoPtr = NULL;	/* The returned value. */
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	return NULL;
    }





    if (!TclCreateSocketAddress(interp, &addrlist, host, port, server, &errorMsg)) {

	goto error;
    }
    if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1, &errorMsg)) {

	goto error;
    }

    if (server) {
	TcpFdList *fds = NULL, *newfds;

	for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	    sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);
	    if (sock == INVALID_SOCKET) {
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * Win-NT has a misfeature that sockets are inherited in child
	     * processes by default. Turn off the inherit bit.
	     */

	    SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers((ClientData)sock, TCP_BUFFER_SIZE);

	    /*
	     * Make sure we use the same port when opening two server sockets
	     * for IPv4 and IPv6.
	     *
	     * As sockaddr_in6 uses the same offset and size for the port
	     * member as sockaddr_in, we can handle both through the IPv4 API.
	     */

	    if (port == 0 && chosenport != 0) {
		((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
		    htons(chosenport);
	    }

	    /*
	     * Bind to the specified port. Note that we must not call
	     * setsockopt with SO_REUSEADDR because Microsoft allows addresses
	     * to be reused even if they are still in use.
	     *
	     * Bind should not be affected by the socket having already been
	     * set into nonblocking mode. If there is trouble, this is one
	     * place to look for bugs.
	     */

	    if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
		== SOCKET_ERROR) {
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }
	    if (port == 0 && chosenport == 0) {
		address sockname;
		socklen_t namelen = sizeof(sockname);

		/*
		 * Synchronize port numbers when binding to port 0 of multiple
		 * addresses.
		 */

		if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
		    chosenport = ntohs(sockname.sa4.sin_port);
		}
	    }

	    /*
	     * Set the maximum number of pending connect requests to the max value
	     * allowed on each platform (Win32 and Win32s may be different, and
	     * there may be differences between TCP/IP stacks).
	     */

	    if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }

	    if (infoPtr == NULL) {
		/*
		 * Add this socket to the global list of sockets.







|
>
|
>















>
>
>
>
|
>


|
>





>



|














|








>


|













|
|






>




>






|
|
|



|







1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
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
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
    int async)			/* If nonzero, connect client socket
				 * asynchronously. */
{
    u_long flag = 1;		/* Indicates nonblocking mode. */
    int asyncConnect = 0;	/* Will be 1 if async connect is in
				 * progress. */
    unsigned short chosenport = 0;
    struct addrinfo *addrlist = NULL, *addrPtr;
				/* Socket address to connect to. */
    struct addrinfo *myaddrlist = NULL, *myaddrPtr;
				/* Socket address for our side. */
    const char *errorMsg = NULL;
    SOCKET sock = INVALID_SOCKET;
    SocketInfo *infoPtr = NULL;	/* The returned value. */
    ThreadSpecificData *tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	return NULL;
    }

    /*
     * Construct the addresses for each end of the socket.
     */

    if (!TclCreateSocketAddress(interp, &addrlist, host, port, server,
	    &errorMsg)) {
	goto error;
    }
    if (!TclCreateSocketAddress(interp, &myaddrlist, myaddr, myport, 1,
	    &errorMsg)) {
	goto error;
    }

    if (server) {
	TcpFdList *fds = NULL, *newfds;

	for (addrPtr = addrlist; addrPtr != NULL; addrPtr = addrPtr->ai_next) {
	    sock = socket(addrPtr->ai_family, SOCK_STREAM, 0);
	    if (sock == INVALID_SOCKET) {
		TclWinConvertError((DWORD) WSAGetLastError());
		continue;
	    }

	    /*
	     * Win-NT has a misfeature that sockets are inherited in child
	     * processes by default. Turn off the inherit bit.
	     */

	    SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);

	    /*
	     * Set kernel space buffering
	     */

	    TclSockMinimumBuffers((void *)sock, TCP_BUFFER_SIZE);

	    /*
	     * Make sure we use the same port when opening two server sockets
	     * for IPv4 and IPv6.
	     *
	     * As sockaddr_in6 uses the same offset and size for the port
	     * member as sockaddr_in, we can handle both through the IPv4 API.
	     */

	    if (port == 0 && chosenport != 0) {
		((struct sockaddr_in *) addrPtr->ai_addr)->sin_port =
			htons(chosenport);
	    }

	    /*
	     * Bind to the specified port. Note that we must not call
	     * setsockopt with SO_REUSEADDR because Microsoft allows addresses
	     * to be reused even if they are still in use.
	     *
	     * Bind should not be affected by the socket having already been
	     * set into nonblocking mode. If there is trouble, this is one
	     * place to look for bugs.
	     */

	    if (bind(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
		    == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }
	    if (port == 0 && chosenport == 0) {
		address sockname;
		socklen_t namelen = sizeof(sockname);

		/*
		 * Synchronize port numbers when binding to port 0 of multiple
		 * addresses.
		 */

		if (getsockname(sock, &sockname.sa, &namelen) >= 0) {
		    chosenport = ntohs(sockname.sa4.sin_port);
		}
	    }

	    /*
	     * Set the maximum number of pending connect requests to the max
	     * value allowed on each platform (Win32 and Win32s may be
	     * different, and there may be differences between TCP/IP stacks).
	     */

	    if (listen(sock, SOMAXCONN) == SOCKET_ERROR) {
		TclWinConvertError((DWORD) WSAGetLastError());
		closesocket(sock);
		continue;
	    }

	    if (infoPtr == NULL) {
		/*
		 * Add this socket to the global list of sockets.
1140
1141
1142
1143
1144
1145
1146

1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206

1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241

1242
1243

1244
1245
1246
1247
1248
1249
1250
1251
1252

1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
		addrPtr = addrPtr->ai_next) {
	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
		    myaddrPtr = myaddrPtr->ai_next) {
		/*
		 * No need to try combinations of local and remote addresses
		 * of different families.
		 */

		if (myaddrPtr->ai_family != addrPtr->ai_family) {
		    continue;
		}

		sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
		if (sock == INVALID_SOCKET) {
		    TclWinConvertWSAError((DWORD) WSAGetLastError());
		    continue;
		}

		/*
		 * Win-NT has a misfeature that sockets are inherited in child
		 * processes by default. Turn off the inherit bit.
		 */

		SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);

		/*
		 * Set kernel space buffering
		 */

		TclSockMinimumBuffers((ClientData)sock, TCP_BUFFER_SIZE);

		/*
		 * Try to bind to a local port.
		 */

		if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
		    == SOCKET_ERROR) {
		    TclWinConvertWSAError((DWORD) WSAGetLastError());
		    goto looperror;
		}
		/*
		 * Set the socket into nonblocking mode if the connect should
		 * be done in the background.
		 */
		if (async) {
		    if (ioctlsocket(sock, (long) FIONBIO, &flag)
			== SOCKET_ERROR) {
			TclWinConvertWSAError((DWORD) WSAGetLastError());
			goto looperror;
		    }
		}

		/*
		 * Attempt to connect to the remote socket.
		 */

		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
		    == SOCKET_ERROR) {
		    TclWinConvertWSAError((DWORD) WSAGetLastError());
		    if (Tcl_GetErrno() != EWOULDBLOCK) {
			goto looperror;
		    }

		    /*
		     * The connection is progressing in the background.
		     */

		    asyncConnect = 1;

		    goto connected;
		} else {
		    goto connected;
		}
	    looperror:
		if (sock != INVALID_SOCKET) {
		    closesocket(sock);
		    sock = INVALID_SOCKET;
		}
	    }
	}
	goto error;

    connected:
	/*
	 * Add this socket to the global list of sockets.
	 */

	infoPtr = NewSocketInfo(sock);

	/*
	 * Set up the select mask for read/write events. If the
	 * connect attempt has not completed, include connect events.
	 */

	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
	if (asyncConnect) {
	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
	    infoPtr->selectEvents |= FD_CONNECT;
	}
    }

  error:
    if (addrlist == NULL)
	freeaddrinfo(addrlist);

    if (myaddrlist == NULL)
	freeaddrinfo(myaddrlist);


    /*
     * Register for interest in events in the select mask. Note that this
     * automatically places the socket into non-blocking mode.
     */

    if (infoPtr != NULL) {
	ioctlsocket(sock, (long) FIONBIO, &flag);
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT, (LPARAM) infoPtr);


	return infoPtr;
    }

    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
    }
    if (sock != INVALID_SOCKET) {
	closesocket(sock);
    }
    return NULL;
}

#if 0
/*
 *----------------------------------------------------------------------
 *
 * CreateSocketAddress --
 *
 *	This function initializes a sockaddr structure for a host and port.
 *
 * Results:
 *	1 if the host was valid, 0 if the host could not be converted to an IP
 *	address.
 *
 * Side effects:
 *	Fills in the *sockaddrPtr structure.
 *
 *----------------------------------------------------------------------
 */

static int
CreateSocketAddress(
    LPSOCKADDR_IN sockaddrPtr,	/* Socket address */
    const char *host,		/* Host. NULL implies INADDR_ANY */
    int port)			/* Port number */
{
    struct hostent *hostent;	/* Host database entry */
    struct in_addr addr;	/* For 64/32 bit madness */

    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	Tcl_SetErrno(EFAULT);
	return 0;
    }

    ZeroMemory(sockaddrPtr, sizeof(SOCKADDR_IN));
    sockaddrPtr->sin_family = AF_INET;
    sockaddrPtr->sin_port = htons((u_short) (port & 0xFFFF));
    if (host == NULL) {
	addr.s_addr = INADDR_ANY;
    } else {
	addr.s_addr = inet_addr(host);
	if (addr.s_addr == INADDR_NONE) {
	    hostent = gethostbyname(host);
	    if (hostent != NULL) {
		memcpy(&addr, hostent->h_addr, (size_t) hostent->h_length);
	    } else {
#ifdef	EHOSTUNREACH
		Tcl_SetErrno(EHOSTUNREACH);
#else
#ifdef ENXIO
		Tcl_SetErrno(ENXIO);
#endif
#endif
		return 0;	/* Error. */
	    }
	}
    }

    /*
     * NOTE: On 64 bit machines the assignment below is rumored to not do the
     * right thing. Please report errors related to this if you observe
     * incorrect behavior on 64 bit machines such as DEC Alphas. Should we
     * modify this code to do an explicit memcpy?
     */

    sockaddrPtr->sin_addr.s_addr = addr.s_addr;
    return 1;			/* Success. */
}
#endif

/*
 *----------------------------------------------------------------------
 *
 * WaitForSocketEvent --
 *
 *	Waits until one of the specified events occurs on a socket.
 *







>






|














|






|
|






<
|

|
|
<







|
|
|








>
|
<
<
|

















|
|










|

>
|

>








|
>














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







1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207

1208
1209
1210
1211

1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231


1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291










































































1292
1293
1294
1295
1296
1297
1298
		addrPtr = addrPtr->ai_next) {
	    for (myaddrPtr = myaddrlist; myaddrPtr != NULL;
		    myaddrPtr = myaddrPtr->ai_next) {
		/*
		 * No need to try combinations of local and remote addresses
		 * of different families.
		 */

		if (myaddrPtr->ai_family != addrPtr->ai_family) {
		    continue;
		}

		sock = socket(myaddrPtr->ai_family, SOCK_STREAM, 0);
		if (sock == INVALID_SOCKET) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    continue;
		}

		/*
		 * Win-NT has a misfeature that sockets are inherited in child
		 * processes by default. Turn off the inherit bit.
		 */

		SetHandleInformation((HANDLE) sock, HANDLE_FLAG_INHERIT, 0);

		/*
		 * Set kernel space buffering
		 */

		TclSockMinimumBuffers((void *) sock, TCP_BUFFER_SIZE);

		/*
		 * Try to bind to a local port.
		 */

		if (bind(sock, myaddrPtr->ai_addr, myaddrPtr->ai_addrlen)
			== SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    goto looperror;
		}
		/*
		 * Set the socket into nonblocking mode if the connect should
		 * be done in the background.
		 */

		if (async && ioctlsocket(sock, (long) FIONBIO, &flag)
			== SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    goto looperror;

		}

		/*
		 * Attempt to connect to the remote socket.
		 */

		if (connect(sock, addrPtr->ai_addr, addrPtr->ai_addrlen)
			== SOCKET_ERROR) {
		    TclWinConvertError((DWORD) WSAGetLastError());
		    if (Tcl_GetErrno() != EAGAIN) {
			goto looperror;
		    }

		    /*
		     * The connection is progressing in the background.
		     */

		    asyncConnect = 1;
		}
		goto connected;



	    looperror:
		if (sock != INVALID_SOCKET) {
		    closesocket(sock);
		    sock = INVALID_SOCKET;
		}
	    }
	}
	goto error;

    connected:
	/*
	 * Add this socket to the global list of sockets.
	 */

	infoPtr = NewSocketInfo(sock);

	/*
	 * Set up the select mask for read/write events. If the connect
	 * attempt has not completed, include connect events.
	 */

	infoPtr->selectEvents = FD_READ | FD_WRITE | FD_CLOSE;
	if (asyncConnect) {
	    infoPtr->flags |= SOCKET_ASYNC_CONNECT;
	    infoPtr->selectEvents |= FD_CONNECT;
	}
    }

  error:
    if (addrlist == NULL) {
	freeaddrinfo(addrlist);
    }
    if (myaddrlist == NULL) {
	freeaddrinfo(myaddrlist);
    }

    /*
     * Register for interest in events in the select mask. Note that this
     * automatically places the socket into non-blocking mode.
     */

    if (infoPtr != NULL) {
	ioctlsocket(sock, (long) FIONBIO, &flag);
	SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
		(LPARAM) infoPtr);

	return infoPtr;
    }

    if (interp != NULL) {
	Tcl_AppendResult(interp, "couldn't open socket: ",
		Tcl_PosixError(interp), NULL);
    }
    if (sock != INVALID_SOCKET) {
	closesocket(sock);
    }
    return NULL;
}











































































/*
 *----------------------------------------------------------------------
 *
 * WaitForSocketEvent --
 *
 *	Waits until one of the specified events occurs on a socket.
 *
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

    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     */

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
	    (LPARAM) infoPtr);

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) infoPtr);

    while (1) {
	if (infoPtr->lastError) {
	    *errorCodePtr = infoPtr->lastError;
	    result = 0;
	    break;
	} else if (infoPtr->readyEvents & events) {
	    break;
	} else if (infoPtr->flags & SOCKET_ASYNC) {
	    *errorCodePtr = EWOULDBLOCK;
	    result = 0;
	    break;
	}

	/*
	 * Wait until something happens.
	 */







<











|







1324
1325
1326
1327
1328
1329
1330

1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349

    /*
     * Reset WSAAsyncSelect so we have a fresh set of events pending.
     */

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) UNSELECT,
	    (LPARAM) infoPtr);

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) infoPtr);

    while (1) {
	if (infoPtr->lastError) {
	    *errorCodePtr = infoPtr->lastError;
	    result = 0;
	    break;
	} else if (infoPtr->readyEvents & events) {
	    break;
	} else if (infoPtr->flags & SOCKET_ASYNC) {
	    *errorCodePtr = EAGAIN;
	    result = 0;
	    break;
	}

	/*
	 * Wait until something happens.
	 */
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
	return NULL;
    }

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
	return (Tcl_Channel) NULL;
    }
    if (Tcl_SetChannelOption(NULL, infoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
	return (Tcl_Channel) NULL;
    }
    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *







|
|
|
|
<
|
|
|
|







1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408

1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
	return NULL;
    }

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
	    "-translation", "auto crlf")) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;

    } else if (TCL_ERROR == Tcl_SetChannelOption(NULL, infoPtr->channel,
	    "-eofchar", "")) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;
    }
    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
 *
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521

    tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers((ClientData) sock, TCP_BUFFER_SIZE);

    infoPtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) infoPtr);

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}







|








|
<







1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462

1463
1464
1465
1466
1467
1468
1469

    tsdPtr = TclThreadDataKeyGet(&dataKey);

    /*
     * Set kernel space buffering and non-blocking.
     */

    TclSockMinimumBuffers(sock, TCP_BUFFER_SIZE);

    infoPtr = NewSocketInfo((SOCKET) sock);

    /*
     * Start watching for read/write events on the socket.
     */

    infoPtr->selectEvents = FD_READ | FD_CLOSE | FD_WRITE;
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);


    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);
    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, (TCL_READABLE | TCL_WRITABLE));
    Tcl_SetChannelOption(NULL, infoPtr->channel, "-translation", "auto crlf");
    return infoPtr->channel;
}
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, 0);
    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close((Tcl_Interp *) NULL, infoPtr->channel);
	return (Tcl_Channel) NULL;
    }

    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------







|
|







1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531

    sprintf(channelName, "sock%Id", (size_t) infoPtr->sockets->fd);

    infoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    infoPtr, 0);
    if (Tcl_SetChannelOption(interp, infoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, infoPtr->channel);
	return NULL;
    }

    return infoPtr->channel;
}

/*
 *----------------------------------------------------------------------
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622

1623
1624
1625
1626
1627
1628
1629

    /*
     * Accept the incoming connection request.
     */

    len = sizeof(SOCKADDR_IN);

    newSocket = accept(fds->fd, (SOCKADDR *)&addr, &len);

    /*
     * Protect access to sockets (acceptEventCount, readyEvents) in socketList
     * by the lock.  Fix for SF Tcl Bug 3056775.
     */

    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

    /*
     * Clear the ready mask so we can detect the next connection request. Note
     * that connection requests are level triggered, so if there is a request
     * already pending, a new event will be generated.
     */







|





>







1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578

    /*
     * Accept the incoming connection request.
     */

    len = sizeof(SOCKADDR_IN);

    newSocket = accept(fds->fd, (SOCKADDR *) &addr, &len);

    /*
     * Protect access to sockets (acceptEventCount, readyEvents) in socketList
     * by the lock.  Fix for SF Tcl Bug 3056775.
     */

    WaitForSingleObject(tsdPtr->socketListLock, INFINITE);

    /*
     * Clear the ready mask so we can detect the next connection request. Note
     * that connection requests are level triggered, so if there is a request
     * already pending, a new event will be generated.
     */
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
    newInfoPtr = NewSocketInfo(newSocket);

    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) newInfoPtr);

    sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
	return;
    }
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close((Tcl_Interp *) NULL, newInfoPtr->channel);
	return;
    }

    /*
     * Invoke the accept callback function.
     */








|
|






|




|







1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
    newInfoPtr = NewSocketInfo(newSocket);

    /*
     * Select on read/write events and create the channel.
     */

    newInfoPtr->selectEvents = (FD_READ | FD_WRITE | FD_CLOSE);
    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM) SELECT,
	    (LPARAM) newInfoPtr);

    sprintf(channelName, "sock%Id", (size_t) newInfoPtr->sockets->fd);
    newInfoPtr->channel = Tcl_CreateChannel(&tcpChannelType, channelName,
	    newInfoPtr, (TCL_READABLE | TCL_WRITABLE));
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-translation",
	    "auto crlf") == TCL_ERROR) {
	Tcl_Close(NULL, newInfoPtr->channel);
	return;
    }
    if (Tcl_SetChannelOption(NULL, newInfoPtr->channel, "-eofchar", "")
	    == TCL_ERROR) {
	Tcl_Close(NULL, newInfoPtr->channel);
	return;
    }

    /*
     * Invoke the accept callback function.
     */

1805
1806
1807
1808
1809
1810
1811
1812
1813
1814
1815
1816
1817
1818
1819
1820
1821
1822
1823
1824
1825
1826
1827
1828
1829
1830
1831
1832
1833
1834
1835
1836
1837
	}

	/*
	 * Check for error condition or underflow in non-blocking case.
	 */

	if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
	    TclWinConvertWSAError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesRead = -1;
	    break;
	}

	/*
	 * In the blocking case, wait until the file becomes readable or
	 * closed and try again.
	 */

	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
	    bytesRead = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) infoPtr);

    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *







|
















|
<







1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778

1779
1780
1781
1782
1783
1784
1785
	}

	/*
	 * Check for error condition or underflow in non-blocking case.
	 */

	if ((infoPtr->flags & SOCKET_ASYNC) || (error != WSAEWOULDBLOCK)) {
	    TclWinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesRead = -1;
	    break;
	}

	/*
	 * In the blocking case, wait until the file becomes readable or
	 * closed and try again.
	 */

	if (!WaitForSocketEvent(infoPtr, FD_READ|FD_CLOSE, errorCodePtr)) {
	    bytesRead = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);


    return bytesRead;
}

/*
 *----------------------------------------------------------------------
 *
1909
1910
1911
1912
1913
1914
1915
1916
1917
1918
1919
1920
1921
1922
1923
1924
1925
1926
1927
1928
1929
1930
1931
1932
1933
1934
1935
1936
1937
1938
1939
1940
1941
1942
1943
1944
1945
1946
	 * send fails with WSAEWOULDBLOCK.
	 */

	error = WSAGetLastError();
	if (error == WSAEWOULDBLOCK) {
	    infoPtr->readyEvents &= ~(FD_WRITE);
	    if (infoPtr->flags & SOCKET_ASYNC) {
		*errorCodePtr = EWOULDBLOCK;
		bytesWritten = -1;
		break;
	    }
	} else {
	    TclWinConvertWSAError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesWritten = -1;
	    break;
	}

	/*
	 * In the blocking case, wait until the file becomes writable or
	 * closed and try again.
	 */

	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
	    bytesWritten = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT,
	    (WPARAM) SELECT, (LPARAM) infoPtr);

    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *







|




|
















|
<







1857
1858
1859
1860
1861
1862
1863
1864
1865
1866
1867
1868
1869
1870
1871
1872
1873
1874
1875
1876
1877
1878
1879
1880
1881
1882
1883
1884
1885
1886

1887
1888
1889
1890
1891
1892
1893
	 * send fails with WSAEWOULDBLOCK.
	 */

	error = WSAGetLastError();
	if (error == WSAEWOULDBLOCK) {
	    infoPtr->readyEvents &= ~(FD_WRITE);
	    if (infoPtr->flags & SOCKET_ASYNC) {
		*errorCodePtr = EAGAIN;
		bytesWritten = -1;
		break;
	    }
	} else {
	    TclWinConvertError(error);
	    *errorCodePtr = Tcl_GetErrno();
	    bytesWritten = -1;
	    break;
	}

	/*
	 * In the blocking case, wait until the file becomes writable or
	 * closed and try again.
	 */

	if (!WaitForSocketEvent(infoPtr, FD_WRITE|FD_CLOSE, errorCodePtr)) {
	    bytesWritten = -1;
	    break;
	}
    }

    SendMessage(tsdPtr->hwnd, SOCKET_SELECT, (WPARAM)SELECT, (LPARAM)infoPtr);


    return bytesWritten;
}

/*
 *----------------------------------------------------------------------
 *
1994
1995
1996
1997
1998
1999
2000
2001
2002
2003
2004
2005
2006
2007
2008
2009
2010
2011
2012
2013
2014
2015
2016
2017
2018
2019
2020
2021
2022
2023
2024
2025
2026
2027
2028
2029
	}
	if (boolVar) {
	    val = TRUE;
	}
	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
		(const char *) &val, sizeof(BOOL));
	if (rtn != 0) {
	    TclWinConvertWSAError(WSAGetLastError());
	    if (interp) {
		Tcl_AppendResult(interp, "couldn't set socket option: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    } else if (!strcasecmp(optionName, "-nagle")) {
	BOOL val = FALSE;
	int boolVar, rtn;

	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!boolVar) {
	    val = TRUE;
	}
	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
		(const char *) &val, sizeof(BOOL));
	if (rtn != 0) {
	    TclWinConvertWSAError(WSAGetLastError());
	    if (interp) {
		Tcl_AppendResult(interp, "couldn't set socket option: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;







|




















|







1941
1942
1943
1944
1945
1946
1947
1948
1949
1950
1951
1952
1953
1954
1955
1956
1957
1958
1959
1960
1961
1962
1963
1964
1965
1966
1967
1968
1969
1970
1971
1972
1973
1974
1975
1976
	}
	if (boolVar) {
	    val = TRUE;
	}
	rtn = setsockopt(sock, SOL_SOCKET, SO_KEEPALIVE,
		(const char *) &val, sizeof(BOOL));
	if (rtn != 0) {
	    TclWinConvertError(WSAGetLastError());
	    if (interp) {
		Tcl_AppendResult(interp, "couldn't set socket option: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
    } else if (!strcasecmp(optionName, "-nagle")) {
	BOOL val = FALSE;
	int boolVar, rtn;

	if (Tcl_GetBoolean(interp, value, &boolVar) != TCL_OK) {
	    return TCL_ERROR;
	}
	if (!boolVar) {
	    val = TRUE;
	}
	rtn = setsockopt(sock, IPPROTO_TCP, TCP_NODELAY,
		(const char *) &val, sizeof(BOOL));
	if (rtn != 0) {
	    TclWinConvertError(WSAGetLastError());
	    if (interp) {
		Tcl_AppendResult(interp, "couldn't set socket option: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
	return TCL_OK;
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
2109
2110
2111
2112
2113
2114
2115
2116
2117
2118
2119

2120
2121
2122
2123
2124
2125
2126
	optlen = sizeof(int);
	ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
		(char *)&err, &optlen);
	if (ret == SOCKET_ERROR) {
	    err = WSAGetLastError();
	}
	if (err) {
	    TclWinConvertWSAError(err);
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
	}
	return TCL_OK;
    }

    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
	address peername;
	socklen_t size = sizeof(peername);

	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }

	    getnameinfo(&(peername.sa), size, host, sizeof(host),







|













>







2046
2047
2048
2049
2050
2051
2052
2053
2054
2055
2056
2057
2058
2059
2060
2061
2062
2063
2064
2065
2066
2067
2068
2069
2070
2071
2072
2073
2074
	optlen = sizeof(int);
	ret = TclWinGetSockOpt(sock, SOL_SOCKET, SO_ERROR,
		(char *)&err, &optlen);
	if (ret == SOCKET_ERROR) {
	    err = WSAGetLastError();
	}
	if (err) {
	    TclWinConvertError(err);
	    Tcl_DStringAppend(dsPtr, Tcl_ErrnoMsg(Tcl_GetErrno()), -1);
	}
	return TCL_OK;
    }

    if (interp != NULL && Tcl_GetVar(interp, SUPPRESS_RDNS_VAR, 0) != NULL) {
	reverseDNS = NI_NUMERICHOST;
    }

    if ((len == 0) || ((len > 1) && (optionName[1] == 'p') &&
	    (strncmp(optionName, "-peername", len) == 0))) {
	address peername;
	socklen_t size = sizeof(peername);

	if (getpeername(sock, (LPSOCKADDR) &(peername.sa), &size) == 0) {
	    if (len == 0) {
		Tcl_DStringAppendElement(dsPtr, "-peername");
		Tcl_DStringStartSublist(dsPtr);
	    }

	    getnameinfo(&(peername.sa), size, host, sizeof(host),
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
	     * getpeername failed - but if we were asked for all the options
	     * (len==0), don't flag an error at that point because it could be
	     * an fconfigure request on a server socket (such sockets have no
	     * peer). {Copied from unix/tclUnixChan.c}
	     */

	    if (len) {
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		if (interp) {
		    Tcl_AppendResult(interp, "can't get peername: ",
			    Tcl_PosixError(interp), NULL);
		}
		return TCL_ERROR;
	    }
	}







|







2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
	     * getpeername failed - but if we were asked for all the options
	     * (len==0), don't flag an error at that point because it could be
	     * an fconfigure request on a server socket (such sockets have no
	     * peer). {Copied from unix/tclUnixChan.c}
	     */

	    if (len) {
		TclWinConvertError((DWORD) WSAGetLastError());
		if (interp) {
		    Tcl_AppendResult(interp, "can't get peername: ",
			    Tcl_PosixError(interp), NULL);
		}
		return TCL_ERROR;
	    }
	}
2166
2167
2168
2169
2170
2171
2172
2173
2174

2175
2176
2177
2178
2179
2180
2181
	    Tcl_DStringStartSublist(dsPtr);
	}
	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
	    sock = fds->fd;
	    size = sizeof(sockname);
	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		int flags = reverseDNS;
		found = 1;


		getnameinfo(&sockname.sa, size, host, sizeof(host),
			NULL, 0, NI_NUMERICHOST);
		Tcl_DStringAppendElement(dsPtr, host);

		/*
		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
		 * can sometimes cause problems (and never have a name).







<

>







2114
2115
2116
2117
2118
2119
2120

2121
2122
2123
2124
2125
2126
2127
2128
2129
	    Tcl_DStringStartSublist(dsPtr);
	}
	for (fds = infoPtr->sockets; fds != NULL; fds = fds->next) {
	    sock = fds->fd;
	    size = sizeof(sockname);
	    if (getsockname(sock, &(sockname.sa), &size) >= 0) {
		int flags = reverseDNS;


		found = 1;
		getnameinfo(&sockname.sa, size, host, sizeof(host),
			NULL, 0, NI_NUMERICHOST);
		Tcl_DStringAppendElement(dsPtr, host);

		/*
		 * We don't want to resolve INADDR_ANY and sin6addr_any; they
		 * can sometimes cause problems (and never have a name).
2206
2207
2208
2209
2210
2211
2212
2213
2214
2215
2216
2217
2218
2219
2220
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else {
	    if (interp) {
		TclWinConvertWSAError((DWORD) WSAGetLastError());
		Tcl_AppendResult(interp, "can't get sockname: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
    }








|







2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
	    if (len == 0) {
		Tcl_DStringEndSublist(dsPtr);
	    } else {
		return TCL_OK;
	    }
	} else {
	    if (interp) {
		TclWinConvertError((DWORD) WSAGetLastError());
		Tcl_AppendResult(interp, "can't get sockname: ",
			Tcl_PosixError(interp), NULL);
	    }
	    return TCL_ERROR;
	}
    }

2295
2296
2297
2298
2299
2300
2301
2302
2303
2304
2305
2306
2307
2308
2309
2310
2311
2312
2313
2314
2315
2316
2317
2318
2319
2320

2321
2322
2323
2324
2325
2326
2327
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. Fix for SF Tcl Bug #557878.
     */

    if (!infoPtr->acceptProc) {
	infoPtr->watchEvents = 0;
	if (mask & TCL_READABLE) {
	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
	}
	if (mask & TCL_WRITABLE) {
	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
	}

	/*
	 * If there are any conditions already set, then tell the notifier to
	 * poll rather than block.
	 */

	if (infoPtr->readyEvents & infoPtr->watchEvents) {
	    Tcl_Time blockTime = { 0, 0 };

	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}

/*
 *----------------------------------------------------------------------







|


















>







2243
2244
2245
2246
2247
2248
2249
2250
2251
2252
2253
2254
2255
2256
2257
2258
2259
2260
2261
2262
2263
2264
2265
2266
2267
2268
2269
2270
2271
2272
2273
2274
2275
2276
				 * TCL_READABLE, TCL_WRITABLE and
				 * TCL_EXCEPTION. */
{
    SocketInfo *infoPtr = instanceData;

    /*
     * Update the watch events mask. Only if the socket is not a server
     * socket. [Bug 557878]
     */

    if (!infoPtr->acceptProc) {
	infoPtr->watchEvents = 0;
	if (mask & TCL_READABLE) {
	    infoPtr->watchEvents |= (FD_READ|FD_CLOSE|FD_ACCEPT);
	}
	if (mask & TCL_WRITABLE) {
	    infoPtr->watchEvents |= (FD_WRITE|FD_CLOSE|FD_CONNECT);
	}

	/*
	 * If there are any conditions already set, then tell the notifier to
	 * poll rather than block.
	 */

	if (infoPtr->readyEvents & infoPtr->watchEvents) {
	    Tcl_Time blockTime = { 0, 0 };

	    Tcl_SetMaxBlockTime(&blockTime);
	}
    }
}

/*
 *----------------------------------------------------------------------
2375
2376
2377
2378
2379
2380
2381
2382
2383
2384
2385
2386
2387
2388
2389
2390
    MSG msg;
    ThreadSpecificData *tsdPtr = arg;

    /*
     * Create a dummy window receiving socket events.
     */

    tsdPtr->hwnd = CreateWindow(classname, classname,
	    WS_TILED, 0, 0, 0, 0, NULL, NULL, windowClass.hInstance, arg);

    /*
     * Signalize thread creator that we are done creating the window.
     */

    SetEvent(tsdPtr->readyEvent);








|
|







2324
2325
2326
2327
2328
2329
2330
2331
2332
2333
2334
2335
2336
2337
2338
2339
    MSG msg;
    ThreadSpecificData *tsdPtr = arg;

    /*
     * Create a dummy window receiving socket events.
     */

    tsdPtr->hwnd = CreateWindow(classname, classname, WS_TILED, 0, 0, 0, 0,
	    NULL, NULL, windowClass.hInstance, arg);

    /*
     * Signalize thread creator that we are done creating the window.
     */

    SetEvent(tsdPtr->readyEvent);

2514
2515
2516
2517
2518
2519
2520
2521
2522
2523
2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536

		    /*
		     * Remember any error that occurred so we can report
		     * connection failures.
		     */

		    if (error != ERROR_SUCCESS) {
			TclWinConvertWSAError((DWORD) error);
			infoPtr->lastError = Tcl_GetErrno();
		    }
		}

		if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
		    if (error != ERROR_SUCCESS) {
			TclWinConvertWSAError((DWORD) error);
			infoPtr->lastError = Tcl_GetErrno();
		    }
		    infoPtr->readyEvents |= FD_WRITE;
		}
		infoPtr->readyEvents |= event;

		/*







|







|







2463
2464
2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485

		    /*
		     * Remember any error that occurred so we can report
		     * connection failures.
		     */

		    if (error != ERROR_SUCCESS) {
			TclWinConvertError((DWORD) error);
			infoPtr->lastError = Tcl_GetErrno();
		    }
		}

		if (infoPtr->flags & SOCKET_ASYNC_CONNECT) {
		    infoPtr->flags &= ~(SOCKET_ASYNC_CONNECT);
		    if (error != ERROR_SUCCESS) {
			TclWinConvertError((DWORD) error);
			infoPtr->lastError = Tcl_GetErrno();
		    }
		    infoPtr->readyEvents |= FD_WRITE;
		}
		infoPtr->readyEvents |= event;

		/*
2673
2674
2675
2676
2677
2678
2679
2680
2681
2682
2683
2684
2685
2686
2687
2688
2689
2690
2691
2692
2693
2694
2695
2696
2697
2698
2699
2700
2701
2702
2703
2704
2705
2706
2707
2708
 */

int
TclWinGetSockOpt(
    SOCKET s,
    int level,
    int optname,
    char * optval,
    int FAR *optlen)
{
    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	return SOCKET_ERROR;
    }

    return getsockopt(s, level, optname, optval, optlen);
}

int
TclWinSetSockOpt(
    SOCKET s,
    int level,
    int optname,
    const char * optval,
    int optlen)
{
    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */







|
|



















|







2622
2623
2624
2625
2626
2627
2628
2629
2630
2631
2632
2633
2634
2635
2636
2637
2638
2639
2640
2641
2642
2643
2644
2645
2646
2647
2648
2649
2650
2651
2652
2653
2654
2655
2656
2657
 */

int
TclWinGetSockOpt(
    SOCKET s,
    int level,
    int optname,
    char *optval,
    int *optlen)
{
    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

    if (!SocketsEnabled()) {
	return SOCKET_ERROR;
    }

    return getsockopt(s, level, optname, optval, optlen);
}

int
TclWinSetSockOpt(
    SOCKET s,
    int level,
    int optname,
    const char *optval,
    int optlen)
{
    /*
     * Check that WinSock is initialized; do not call it if not, to prevent
     * system crashes. This can happen at exit time if the exit handler for
     * WinSock ran before other exit handlers that want to use sockets.
     */

Changes to win/tclWinTime.c.

196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
    return retval;

}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTimeZone --
 *
 *	Determines the current timezone. The method varies wildly between
 *	different Platform implementations, so its hidden in this function.
 *
 * Results:
 *	Minutes west of GMT.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

int
TclpGetTimeZone(
    unsigned long currentTime)
{
    int timeZone;

    tzset();
    timeZone = timezone / 60;

    return timeZone;
}

/*
 *----------------------------------------------------------------------
 *
 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds since the
 *	beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the current time in timePtr.







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







196
197
198
199
200
201
202





























203
204
205
206
207
208
209
    return retval;

}

/*
 *----------------------------------------------------------------------
 *





























 * Tcl_GetTime --
 *
 *	Gets the current system time in seconds and microseconds since the
 *	beginning of the epoch: 00:00 UCT, January 1, 1970.
 *
 * Results:
 *	Returns the current time in timePtr.
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
     * paused state so we need to timeout and continue.
     */

    WaitForSingleObject(timeInfo.calibrationThread, 100);
    CloseHandle(timeInfo.exitEvent);
    CloseHandle(timeInfo.calibrationThread);
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetTZName --
 *
 *	Gets the current timezone string.
 *
 * Results:
 *	Returns a pointer to a static string, or NULL on failure.
 *
 * Side effects:
 *	None.
 *
 *----------------------------------------------------------------------
 */

char *
TclpGetTZName(
    int dst)
{
    int len;
    char *zone, *p;
    TIME_ZONE_INFORMATION tz;
    Tcl_Encoding encoding;
    ThreadSpecificData *tsdPtr = TCL_TSD_INIT(&dataKey);
    char *name = tsdPtr->tzName;

    /*
     * tzset() under Borland doesn't seem to set up tzname[] at all.
     * tzset() under MSVC has the following weird observed behavior:
     *	 First time we call "clock format [clock seconds] -format %Z -gmt 1"
     *	 we get "GMT", but on all subsequent calls we get the current time
     *	 ezone string, even though env(TZ) is GMT and the variable _timezone
     *	 is 0.
     */

    name[0] = '\0';

    zone = getenv("TZ");
    if (zone != NULL) {
	/*
	 * TZ is of form "NST-4:30NDT", where "NST" would be the name of the
	 * standard time zone for this area, "-4:30" is the offset from GMT in
	 * hours, and "NDT is the name of the daylight savings time zone in
	 * this area. The offset and DST strings are optional.
	 */

	len = strlen(zone);
	if (len > 3) {
	    len = 3;
	}
	if (dst != 0) {
	    /*
	     * Skip the offset string and get the DST string.
	     */

	    p = zone + len;
	    p += strspn(p, "+-:0123456789");
	    if (*p != '\0') {
		zone = p;
		len = strlen(zone);
		if (len > 3) {
		    len = 3;
		}
	    }
	}
	Tcl_ExternalToUtf(NULL, NULL, zone, len, 0, NULL, name,
		sizeof(tsdPtr->tzName), NULL, NULL, NULL);
    }
    if (name[0] == '\0') {
	if (GetTimeZoneInformation(&tz) == TIME_ZONE_ID_UNKNOWN) {
	    /*
	     * MSDN: On NT this is returned if DST is not used in the current
	     * TZ
	     */

	    dst = 0;
	}
	encoding = Tcl_GetEncoding(NULL, "unicode");
	Tcl_ExternalToUtf(NULL, encoding,
		(char *) ((dst) ? tz.DaylightName : tz.StandardName), -1,
		0, NULL, name, sizeof(tsdPtr->tzName), NULL, NULL, NULL);
	Tcl_FreeEncoding(encoding);
    }
    return name;
}

/*
 *----------------------------------------------------------------------
 *
 * TclpGetDate --
 *
 *	This function converts between seconds and struct tm. If useGMT is







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







481
482
483
484
485
486
487























































































488
489
490
491
492
493
494
     * paused state so we need to timeout and continue.
     */

    WaitForSingleObject(timeInfo.calibrationThread, 100);
    CloseHandle(timeInfo.exitEvent);
    CloseHandle(timeInfo.calibrationThread);
}
























































































/*
 *----------------------------------------------------------------------
 *
 * TclpGetDate --
 *
 *	This function converts between seconds and struct tm. If useGMT is